home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 098 / rbs5bbas.arc / RBBS-PC.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1985-08-26  |  49.4 KB  |  933 lines

  1. 3  ' $linesize: 132 $title: 'RBBS-PC CPC12-5B, Copyright 1985 by D. Thomas Mack'; ' WARNING !!! DO NOT CHANGE, BYPASS OR REMOVE LINES 3-121
  2. 100  CLEAR:CLS:DEFINT A-Z:DIM LG$(21):LG$(1)="Registration Check Failed":LG$(3)="Locked out attempt":LG$(4)="Password Attempt Failed":P$="Password":VB$="RBBS-PC VERSION ":LG$(5)="Auto Lockout done":LG$(6)="Name in use on another Node! ":LF=-1
  3. 102  TT$=". Please tell SYSOP":TU$="^READ^":E1$=" Error in #":F8$="Enter full filename to ":FU$=" type <A)scii, <M>NP, <X>modem, <Q>uit":LG$(0)="More (Y),N,NS,RE":LG$(2)="Sysop name attempted":WIDTH 80:SCREEN 0,0,0:KEY OFF:XA$=CHR$(19):XON$=CHR$(17)
  4. 104  DEF FNV(A1$,A)=VAL(MID$(A1$,A,2)):DEF FNTI!=CSNG(FIX((VAL(MID$(TIME$,1,2))*60*60)+(VAL(MID$(TIME$,4,2))*60)+(VAL(MID$(TIME$,7,2))*1))):DEF FNBL$="BLK"+RIGHT$("0000"+RIGHT$(STR$(BLK),LEN(STR$(BLK))-1),5):DEF FNS$(A1$,A)=A1$+SPACE$(A-LEN(A1$))
  5. 105  DEF FNCD$(A1$)=CHR$(FNV(A1$,7))+CHR$(FNV(A1$,1))+CHR$(FNV(A1$,4)):DEF FNUD$(A1$)=RIGHT$(STR$(ASC(MID$(A1$,2))),2)+"/"+RIGHT$(STR$(ASC(MID$(A1$,3))),2)+"/"+RIGHT$(STR$(ASC(A1$)),2):DEF FNBT(Y,X)=(Y AND X)>0
  6. 110  DEF FNDC$(A1$)=RIGHT$(A1$,2)+LEFT$(A1$,2)+MID$(A1$,4,2):DEF FNSS$(A1$)=LEFT$(A1$+SPACE$(2),INSTR(A1$+SPACE$(2),SPACE$(2))-1):TOA!=FRE("A"):LS$="UM UU UB UD":TI$=TIME$:ON ERROR GOTO 13000:DEF SEG:CE=((PEEK(&H2E)+256*PEEK(&H2F))-110)<>0
  7. 115  CR$=CHR$(13):LF$=CHR$(10):RTN$=CR$+LF$:VA$="CPC12.5B":CA$="RBBS-PC.DEF":DIM SA(7),MD(21),UA(16),FS(10),ME$(6),HE$(9),M(250,2),A$(30),B$(128):IF CE THEN GOSUB 59000 ELSE NC=2:ND$ = "1"
  8. 117  OPEN "I",2,CA$:INPUT #2,FA$,PB$,PC$,NA$,NB$,CB,AA,AB,TV!,ME,DF,UB$,XPR,BC,BA,DF,DF,ME$(1),ME$(2),ME$(3),ME$(4),ME$(5),CQ$,DF,OA,SEC,P,LW,WA,DF$:PL=P:INPUT#2,MB$,LG$(11),CF$,CG$,UF1$,WB$,LG$(12),DIR$,CP$,SO,SD$,DF$,DA,QU,PG,QX,RC$,CH$
  9. 118  INPUT#2,LG$(13),LG$(14),HE$(1),HE$(2),HE$(3),HE$(4),HE$(5),HE$(6),HE$(7),HE$(8),HE$(9),LG$(8),LG$(7),DF$,RD,BD,UDR,DF,SB,CYC,DF,TOA!,LG$(18):INPUT#2,MO,DB,SE,FB$,SF,KA$,VB,SA(1),SA(2),SA(3),SA(4),SA(5),SA(6),SA(7),PD$,MP,DF,UPS,MF,DAY
  10. 119  INPUT#2,MD(1),MD(2),MD(3),MD(4),MD(5),MD(6),MD(7),MD(8),MD(9),MD(10),MD(11),MD(12),MD(13),MD(14),MD(15),MD(16),MD(17),MD(18),MD(19),MD(20),MD(21),SY$,TY
  11. 121  INPUT#2,FS(1),FS(2),FS(3),FS(4),FS(5),FS(6),FS(7),FS(8),FS(9),FS(10),UA(1),UA(2),UA(3),UA(4),UA(5),UA(6),UA(7),UA(8),UA(9),UA(10),UA(11),UA(12),UA(13),UA(14),UA(15),UA(16),UPX!,C,RP,F$,D,MN,PA$,BA$:MES$=MB$:IF CE THEN VA$=VA$ ELSE SB=0
  12. 123  UF$=UF1$:IF C<>1 THEN DEF SEG=0:MC=PEEK(&H1FE)+256*PEEK(&H1FF):IF MC>0 THEN DEF SEG=MC:DF=(&H64+PEEK(&H58)+256*PEEK(&H59)+&HC):IF PEEK(DF)=&H1 OR &H2 THEN POKE(DF),&H9
  13. 124  UB$=UB$+"."+DIR$:IF MC THEN AX=&HB00:BX=0:GOSUB 60510:AX=&H701:BX=0:GOSUB 60510:BX=-4:AX=&H1:IF CP$="COM2" THEN BX=-3:GOSUB 60510 ELSE GOSUB 60510
  14. 125  PRINT VB$;VA$;" Node ";ND$;LF$;"Free memory: ";FRE("A");LF$;LF$;"Press:":FOR I=1 TO 11:INPUT#2,A$:PRINT A$:NEXT:A$="":FOR I=1 TO 10:KEY I,"":NEXT:IF SB=2 THEN CN$=SPACE$(535):CALL INITIO(A)
  15. 127  BK$=CHR$(8)+CHR$(32)+CHR$(8):BK1$=CHR$(29)+CHR$(32)+CHR$(29):MQ=72:IF CP$="COM2"THEN LSB=&H2F8:MSB=&H2F9:LCR=&H2FB:MCR=&H2FC:LSR=&H2FD:MSR=&H2FE ELSE LSB=&H3F8:MSB=&H3F9:LCR=&H3FB:MCR=&H3FC:LSR=&H3FD:MSR=&H3FE
  16. 130  SOH$=CHR$(1):EOT$=CHR$(4):ACK$=CHR$(6):NAK$=CHR$(21):CAN$=CHR$(24):ESC$=CHR$(27):LG$(17)=CHR$(0)+CHR$(112):NE=&H100:IF NOT MN THEN FU$=MID$(FU$,1,14)+MID$(FU$,22)
  17. 175  GOSUB 30500:GET 1,NC:AVA=FNV(R$,32):AC=FNV(R$,34):SG=FNV(R$,36):LH=FNV(R$,38):WI=FNV(R$,40):PRT=FNV(R$,58):MID$(R$,57,1)="I":PUT 1,NC:GOSUB 56000:CDX=LOF(2)/64
  18. 180  GET 2,CDX:IF LEFT$(CL$,13) = STRING$(13,0) THEN CDX=CDX-1:GOTO 180
  19. 187  GOSUB 41500:IF LH THEN LPRINT VB$;VA$;" Node ";ND$;" up at ";TIM$;" on ";DATE$
  20. 200  IF INP(MSR)<128 THEN OUT MCR,&H4:GOSUB 50510:OUT MCR,&H0:CLOSE 3
  21. 220  OPEN CP$+":"+BA$+",N,8,1,RS,CD,DS" AS #3:BE=-1:IF INP(MSR) > 127 OR WI THEN GOSUB 44000:GOSUB 4910:GOTO 410 ELSE A$="ATZ":GOSUB 52070:GOSUB 50510:A$=SD$:GOSUB 52070
  22. 235  PRINT LF$;"READY FOR CALLS AT ";TIM$;" ON ";DATE$;LF$;LF$;"<SCREEN CLEARS TO PREVENT BURN IN>":TCA!=FNTI!:GOSUB 49000:QQ=255:IF VAL(MID$(SD$,24,3))=255 THEN QQ=0:BLK=QQ
  23. 239  TR!=0:IF CB>0 THEN TR!=FNTI!:COLOR 7,0,0 ELSE COLOR QU,PG,QX
  24. 240  IF SG THEN 253 ELSE X=1:WHILE INP(MSR)<128:X$=INKEY$:FK$=X$:GOSUB 60000
  25. 250  IF X$=CHR$(27) THEN 253 ELSE 260
  26. 253  TI!=FNTI!:GOSUB 14500:LJ=-1:TY=32400:IF KA$<>"NONE" THEN LOCATE 24,1:INPUT "Enter PASSWORD";Z$:GOSUB 5000:IF Z$ <> KA$ THEN 13549
  27. 255  BE=-1:GR=1:CI$="LOCAL":LF=-1:RTN$=LF$:UG=SE:GOTO 827
  28. 260  IF TR!>0 THEN IF FNTI!-TR!>45 THEN TR!=0:RBC=0:Q=0:IF(PRT AND CB)THEN PRINT"Ringback timeout";PA$:IF BLK THEN QQ=0 ELSE QQ=255
  29. 265  MMM!=FNTI!-TCA!:IF MMM!>120 THEN LOCATE,,0:CLS:TCA!=FNTI!
  30. 266  IF (INP(MSR)AND &H40)>0 AND CB>0 THEN GOTO 275
  31. 270  WEND:IF CB=0 THEN 321
  32. 275  A$="ATS1?":WHILE(INP(MSR)AND &H40):WEND:IF LOC(3)THEN X$=INPUT$(LOC(3),3):GOSUB 52070 ELSE GOSUB 52070
  33. 290  INPUT#3,X$:IF LEN(X$)=0 THEN 290 ELSE A$="":IF QQ=0 AND Q<VAL(X$) THEN Q=VAL(X$):GOTO 305
  34. 300  RBC=RBC+1:A$=STR$(RBC):IF QQ=0 THEN RBC=VAL(X$):A$=STR$(RBC)
  35. 305  IF PRT THEN PRINT TIME$+" Ring "+A$+PA$
  36. 310  IF RBC<CB THEN 239
  37. 320  A$="ATQ0X1V1A":GOSUB 52070
  38. 321  TCC!=FNTI!+30:DF$=""
  39. 322  IF INP(MSR)<128 AND FNTI!<TCC! THEN 322 ELSE IF INP(MSR)<128 THEN 10595 ELSE GOSUB 50510
  40. 324  DF$=DF$+INPUT$(LOC(3),3):PRINT DF$:IF FNTI!=>TCC! THEN 10595
  41. 325  IF INSTR(DF$,"CONNECT") THEN  QQ=VAL(MID$(DF$,INSTR(DF$,"CONNECT")+8,4)):GOTO 330 ELSE 324
  42. 330  GOSUB 21280:IF QQ=0 OR QQ=300 THEN Q=&H180:BPS=-1:GOSUB 1654 ELSE IF QQ=1200 OR QQ=2400 THEN BPS=-2-(QQ/1200):Q=48*(BPS+5):GOSUB 1654 ELSE 324
  43. 345  GOSUB 41500:UC=-1:TI!=FNTI!:A$="Welcome to "+F$+CR$:Z$=A$:GOSUB 1399:TOP=-1
  44. 400  GOSUB 4910:A1$="What is your ":GOSUB 12500:PE$=MID$("    300 45012002400",(-4*BPS),4)+" BAUD,"+MID$("N,8,1E,7,1",6+5*BE,5):IF FF THEN I=1:GOTO 10620
  45. 410  FOR X=2 TO MG+1:GET 1,X:IF INSTR(R$,NAM$) THEN IF MID$(R$,57,1)="A" THEN I=6:LG$(6)=LEFT$(LG$(6),29)+MID$(R$,1,25):GOTO 10620
  46. 420  NEXT:GET 1,NC:GOSUB 25000:LL=(NAM$=LEFT$(R$,LEN(NAM$))):IF FE$=PB$AND LK$=PC$THEN UC=0:CI$="REMOTE":GOTO 827
  47. 445  IF INSTR(NAM$,"SYSOP") OR INSTR(NAM$,NA$+" "+NB$) THEN I=2:GOTO 10620
  48. 455  FOR J=1 TO LEN(NAM$):X=ASC(MID$(NAM$,J,1)):IF(X<65 OR X>90)AND(X<>32 AND X<>39 AND X<>45 AND X<>46)THEN 400
  49. 465  NEXT:TEA$=NAM$:GOSUB 12600:IF NOT FG THEN 700 ELSE GOSUB 21995:GOSUB 9500:UIX=LOC(2):IF UG<MO THEN I=3:GOTO 10620 ELSE GOSUB 26500:CI$=CS$:I=0:MR=4:KEE$=PW$:MES=0:IF D$<>LEFT$(TD$,8) THEN ET=0 ELSE ET=CVI(ET$)
  50. 480  IF Q=3 THEN Z$=B$(3):TDA=1:GOSUB 677 ELSE GOSUB 675
  51. 630  IF PF THEN I=4:GOTO 10620
  52. 643  GOSUB 41070:NF=0:LM$=FNDC$(FNUD$(LND$)):IF MID$(LM$,3,1)=" " THEN MID$(LM$,3,1)="0
  53. 655  IF MID$(LM$,5,1)=" " THEN MID$(LM$,5,1)="0
  54. 660  GOTO 800
  55. 665  IF KEE$=PW$ THEN PF=0:RETURN
  56. 667  TDA=0
  57. 670  TDA=TDA+1:IF TDA>MR THEN PF=-1:RETURN
  58. 675  A$=P$+" (dots echo)":GOSUB 45010:Z$=B$(1)
  59. 677  IF LEN(Z$)>15 THEN 680 ELSE GOSUB 5000:Z$=FNS$(Z$,15):IF KEE$=Z$ THEN PF=0:RETURN
  60. 680  IF MES THEN A$="Wrong password":GOSUB 1405:GOTO 670 ELSE 670
  61. 700  Z$=FE$:GOSUB 12570:IF FG THEN GOSUB 21995:GOTO 12595 ELSE Z$=LK$:GOSUB 12570:IF FG THEN GOSUB 21995:GOTO 12595
  62. 710  IF UIX=0 THEN 13540
  63. 720  NF=-1:GOSUB 9400:GOSUB 12630:LSET NM$="NEWUSER":PUT 2,UIX:UG=DB:IF UG < MO THEN I=3:GOTO 10620
  64. 730  GOSUB 12950:DF$=HU$:TN=-1:F$=LG$(12):STI=0:GOSUB 1790:STI=-1:TN=0:GOSUB 9400:LSET HU$=DF$:A$=NAM$+" from "+CS$:GOSUB 1405
  65. 740  A$="<R>egister, <C>hange name/address, <D>isconnect (don't register)":GOSUB 1500:Z$=B$(1):GOSUB 5000:S=INSTR("RCD",Z$):IF S>1 THEN LSET NM$=STRING$(31,0):PUT 2,UIX:GOSUB 27500:FF=0
  66. 745  ON S GOTO 755,400,750:GOTO 740
  67. 750  Z$=NAM$+" refused to register":GOSUB 13670:UIX=0:GOTO 13540
  68. 755  GOSUB 12800:A$="PASSWORD verification (dots echo)":GOSUB 45010:SWAP Z$,B$(1):GOSUB 5000:IF B$(1)<>Z$THEN A$="Don't match!":GOSUB 1405:GOTO 755
  69. 760  GOSUB 5000:LSET PW$=Z$:A$="REMEMBER your password":GOSUB 1399:TFA=UG:GOSUB 42950:TN=-1:GOSUB 43000:TN=0:GOSUB 43030:GOSUB 42800:GOSUB 42700:GOSUB 12900:MQ=64:XPR=0:GOSUB 9600
  70. 800  MUIX=UIX:HUG=UG:A$="Logging "+NAM$:GOSUB 1398:TGA=CVI(MID$(OP$,1,2))+1:GOSUB 9500:A1$=TD$:A$=VB$+VA$+" NODE "+ND$+RTN$+" OPERATING AT "+PE$:TDA=0:GOSUB 1399
  71. 815  DLD=CVI(UDL$):ULD=CVI(UUL$):LO=-LO*(LO<=LE):LSET OP$=MKI$(TGA)+MID$(OP$,3):LSET TD$=D$+" "+TI$:PUT 2,UIX:GOSUB 27500:IF NOT LL THEN STI=OA:TN=-1:F$=WB$:GOSUB 43030:GOSUB 6000:TN=0:STI=0
  72. 816  IF NF THEN TN=-1:GOSUB 1700:TN=0:NF=0 ELSE A$="Times on:"+STR$(TGA):GOSUB 1405:A$="Last time on was: "+A1$:GOSUB 1405
  73. 817  IF SEC THEN A$="Files Downloaded:"+STR$(DLD)+"  Uploaded:"+STR$(ULD):GOSUB 1400
  74. 820  IF RP THEN GOSUB 5400
  75. 825  JJ=INSTR(CI$,SPACE$(2)):CI$=LEFT$(CI$,(JJ-1)):GOTO 830
  76. 827  FE$=NA$:LK$=NB$:NAM$="SYSOP":UG=SE:SH=-1:MQ=72:GOSUB 41500:IF LJ THEN PRT=-1:SG=-1:GOSUB 33090
  77. 830  IF UG<>DB THEN Z$="":Z=0:GOSUB 5140:IF FG THEN TV!=TJA
  78. 837  IF NOT LJ THEN Z$=NAM$+" on at "+D$+", "+TIM$+" from "+CI$+", "+PE$:NG$=FNS$(Z$,128):Z$="  "+Z$:GOSUB 13674
  79. 842  TV!=(TV!+DAY*ET)*60:CH!=0:GOSUB 4910:CJ#=CJ#+1+SH:GOSUB 24000:GET 1,NC:MID$(R$,1,31)=FNS$(NAM$,31):MID$(R$,57,1)="A":PUT 1,NC:GOSUB 21996:IF SH THEN 900 ELSE SH=(UG>=SE)
  80. 850  GOSUB 950:IF BC<1 THEN A$="no bulletins today":GOSUB 1397:GOTO 900
  81. 855  IF SO THEN A$="Skip the"+STR$(BC)+" bulletins":GOSUB 1499:IF YES THEN 900
  82. 860  GOSUB 9705
  83. 900  GOSUB 1900:GOSUB 950:GOTO 955
  84. 950  IF NOT PRT THEN RETURN
  85. 953  C.C=CSRLIN:C.L=POS(0):HH=LEN(NAM$)+LEN(CI$)+LEN(FH$)+14
  86. 954  LOCATE 25,1:PRINT FH$;SPACE$(79-HH);NAM$;" ";CI$;" ";LS$;:LOCATE C.C,C.L:RETURN
  87. 955  GOSUB 4850:STI=-1
  88. 1200  CLOSE 1:AM$="M":GOSUB 49000:STI=-1:Q=0:GOSUB 1405:IF UG<SF THEN A1$=">":GOTO 1240 ELSE A1$=",1,..,7>":IF NOT XPR THEN F$=ME$(1):GOSUB 43025
  89. 1240  GOSUB 41050:NH=0:IF NOT XPR THEN F$=ME$(2):GOSUB 43025
  90. 1250  GOSUB 49000:A$=GRN$+"Main Func <B,C,D,E,F,G,H,I,J,K,L,O,P,Q,R,S,U,V,W,X,?"+A1$:GOSUB 1499:IF Q=0 THEN 1250
  91. 1270  FOR J=1 TO Q:Z$ = B$(J):GOSUB 5000:FF = VAL(Z$):IF FF=0 THEN 1280 ELSE IF FF<1 OR FF>7 THEN GOSUB 1350:GOTO 1200
  92. 1274  IF UG < SA(FF) THEN RS$="Sysop "+Z$:GOSUB 1380:GOTO 1200
  93. 1276  ON FF GOSUB 10070,10090,10390,10530,11000,33070,10930:GOTO 1200
  94. 1280  FF=INSTR("BCDEFGHIJKLOPQRSUVWX?",Z$): IF FF=0 THEN GOSUB 1350:GOTO 1200
  95. 1290  IF UG<MD(FF) THEN RS$="MMenu "+Z$:GOSUB 1380:GOTO 1200
  96. 1320  ON FF GOSUB 9700,1800,10970,2000,20015,10560,1740,1760,5300,3900,5200,4700,1900,4320,4330,4340,1330,1495,9800,4240,1700:NEXT:GOTO 1200
  97. 1330  AM$="U":GOSUB 41050:IF NOT XPR THEN F$=ME$(4):GOSUB 43025
  98. 1334  GOSUB 49000:A$=GRN$+"Utility Func <B,C,F,G,H,L,M,N,P,Q,R,S,T,U,X,!>":GOSUB 1499:IF Q=0 THEN GOSUB 1350:GOTO 1330
  99. 1336  Z$=B$(J):GOSUB 5000:FF=INSTR("BCFGHLMNPQRSTUX!",Z$):IF FF=0 THEN GOSUB 1360:GOTO 1330 ELSE IF UG<UA(FF) THEN RS$="Util "+Z$:GOSUB 1380:GOTO 1330
  100. 1338  ON FF GOSUB 5500,42960,42800,43000,1780,4100,10925,42710,5110,1200,5400,4850,9100,10090,4240,4200:GOTO 1330
  101. 1350  IF XPR THEN RETURN ELSE GOSUB 1405
  102. 1360  A$=B$(J)+" is invalid, "+FE$:GOTO 2210
  103. 1380  A$="SYSOP must authorize":GOSUB 1397:Z$="SV!-"+RS$:GOSUB 13670:NI=NI+1:IF VB=0 OR NI<=VB THEN RETURN
  104. 1385  IF UIX<1 THEN RETURN ELSE A$="SECURITY VIOLATION!  Sysop can reinstate":IF UG=<MO THEN A$="":UG=UG-1 ELSE UG=MO
  105. 1386  GOSUB 1405:I=5:GOSUB 21997:GET 2,UIX:LSET SL$=MKI$(UG):PUT 2,UIX:GOTO 10620
  106. 1397  A$="Sorry, "+FE$+", "+A$:GOTO 1405
  107. 1398  GOSUB 1485:GOTO 1405
  108. 1399  GOSUB 1485
  109. 1400  CR=1
  110. 1403  CR=CR+1
  111. 1405  RET=0:IF NOT STI OR CM THEN 1435
  112. 1410  Y$=INKEY$:FK$=Y$:GOSUB 60000:IF LJ THEN 1430
  113. 1415  IF EOF(3)THEN GOSUB 42000:GOTO 1430
  114. 1420  Y$=INPUT$(1,3)
  115. 1425  IF Y$=XA$ THEN WHILE EOF(3):GOSUB 42000:WEND:GOTO 1420
  116. 1430  IF Y$=CHR$(11) AND STI THEN 1475
  117. 1432  IF Y$=CHR$(24) AND STI THEN 1475
  118. 1435  IF PRT THEN LOCATE ,,1:C.R=1:WHILE C.R<=LEN(A$):C.C=C.R+INSTR(MID$(A$,C.R)+CR$,CR$)-2:PRINT MID$(A$,C.R,C.C-C.R+1);MID$(LF$,1,-(C.C<LEN(A$)));:C.R=C.C+LEN(RTN$)+2:WEND
  119. 1437  IF LJ THEN 1450
  120. 1440  IF UC THEN SWAP A$,Z$:GOSUB 5000:SWAP A$,Z$
  121. 1445  PRINT#3,A$;
  122. 1450  IF CR<>1 THEN GOSUB 1485 ELSE IF CR>1 THEN GOSUB 1485
  123. 1470  Y$="":A$=Y$:CR=0:RETURN
  124. 1475  CR=2:A$="":RET=STI:STI=0:GOSUB 1410:STI=RET:RET=-1:NH=0:GOTO 1470
  125. 1485  IF PRT THEN PRINT
  126. 1490  IF NOT LJ THEN PRINT#3,RTN$;
  127. 1495  RETURN
  128. 1496  RTN$=MID$(CR$,1,-(CI$<>"LOCAL"))+NUL$+MID$(LF$,1,-LF):RETURN
  129. 1499  GOSUB 1485
  130. 1500  GOSUB 42000:TOA!=FRE("A"):TCC!=FNTI!:A=0:B=0:C=0:Q=1:EOL=0:YES=0:B$="":NO=0:A$=A$+"? ":GOSUB 1403:IF LJ THEN LINE INPUT"",B$:GOTO 1575 ELSE IF BA THEN PRINT#3,CHR$(7);
  131. 1525  WHILE EOF(3):GOSUB 42000:MMM!=FNTI!-TCC!:IF MMM!>TY THEN 10595
  132. 1530  Y$=INKEY$:FK$=Y$:GOSUB 60000:IF Y$<>"" THEN 1545 ELSE WEND:GOSUB 42010
  133. 1540  Y$=INPUT$(1,3):IF TOP THEN 1541 ELSE IF Y$=CHR$(127)THEN 1635 ELSE 1545
  134. 1541  IF ASC(Y$)=141 THEN OUT LCR,&H1A:BE=0:GR=0:TOP=0
  135. 1542  Y$=CHR$(ASC(Y$) AND 127)
  136. 1545  IF Y$=CHR$(8) OR Y$=CHR$(7) OR Y$=CHR$(26) OR Y$=CHR$(227) THEN 1635
  137. 1550  IF Y$<" " AND Y$<>CR$THEN 1525
  138. 1553  IF Y$="^" THEN 1525
  139. 1555  IF PRT THEN PRINT Y$;
  140. 1557  IF NOT SI THEN PRINT#3,Y$; ELSE PRINT#3,".";
  141. 1560  IF Y$=CR$THEN 1570
  142. 1563  IF LEN(B$)=>254 THEN A$="Input too long!":GOSUB 1405:GOTO 1500
  143. 1565  B$=B$+Y$:GOTO 1525
  144. 1570  IF LF THEN PRINT#3,LF$;
  145. 1575  A=INSTR(B$,";"):IF A=0 THEN 1620
  146. 1580  B$(1)=LEFT$(B$,A-1):A=A+1
  147. 1585  B=INSTR(A,B$,";"):C=B-A:IF C<1 THEN EOL=-1:C=128
  148. 1595  DF$=MID$(B$,A,C):IF DF$<>"" THEN Q=Q+1:B$(Q)=DF$
  149. 1605  IF NOT EOL AND Q<10 THEN A=B+1:GOTO 1585
  150. 1610  IF LEN(B$)>64 THEN A$="Try again, "+FE$:GOSUB 1405:GOTO 1500 ELSE 1625
  151. 1620  B$(1)=B$:Q=1:IF B$="" THEN Q=0:RETURN
  152. 1625  SWAP Z$,B$:GOSUB 5000:SWAP Z$,B$:IF LEFT$(B$,1)="Y" THEN YES=-1 ELSE IF LEFT$(B$,1)="N" THEN NO=-1
  153. 1628  IF B$(Q)="NS" OR B$(Q)="ns" THEN NO=0:NH=-1:B$(Q)="":IF Q>1 THEN Q=Q-1
  154. 1629  IF B$="RE" AND UG=>MD(4) THEN RE=-1:RETURN ELSE IF B$="K" AND UG=>MD(10) THEN KB=-1:RETURN ELSE RETURN
  155. 1635  IF LEN(B$)=0 THEN 1525
  156. 1640  B$=LEFT$(B$,LEN(B$)-1):IF PRT THEN PRINT BK1$;
  157. 1650  PRINT#3,BK$;:GOTO 1525
  158. 1654  R1=INP(LCR):DF=INP(MSB):OUT MSB,0:OUT LCR,R1 OR 128:IF Q=384 THEN OUT LSB,&H80:OUT MSB,&H1:GOTO 1684
  159. 1662  IF Q=256 THEN OUT LSB,&H0:OUT MSB,&H1:GOTO 1684
  160. 1664  IF Q=96 THEN OUT LSB,&H60:OUT MSB,&H0:GOTO 1684
  161. 1666  IF Q=48 THEN OUT LSB,&H30:OUT MSB,&H0
  162. 1684  OUT LCR,R1:OUT MSB,DF:RETURN
  163. 1700  F$=HE$(2):GOTO 1790
  164. 1740  F$=HE$(1):GOTO 1790
  165. 1760  F$=WB$:GOTO 1790
  166. 1780  F$=HE$(8)
  167. 1790  GOSUB 43030:GOSUB 6000:RETURN
  168. 1800  A$="Leave private comment for Sysop (Y/N)":GOSUB 1499:MQ=72:IF NOT YES THEN 2210
  169. 1840  T$="SYSOP":SUB$="COMMENT":SC=-1:GOTO 2007
  170. 1850  CLOSE 2:BX=&H3:EN$=CG$:GOSUB 29000:OPEN "A",2,CG$:A$=FE$+", Thanks for comments!":GOSUB 1399:GOSUB 41510:PRINT#2,NAM$,D$,TIM$:FOR X=1 TO LI:PRINT#2,A$(X):NEXT:PRINT#2,CR$:CLOSE 2:BX=&H3:EN$=CG$:GOTO 29500
  171. 1900  GOSUB 4910:A$="Checking messages":GOSUB 1403:GOSUB 30500:T=-1:DQ=0:LC=0:R=FMR:DE!=0:FOR DF=1 TO 250:M(DF,1)=0:M(DF,2)=0:NEXT
  172. 1905  GET 1,R:RR=VAL(MID$(R$,118)):IF RR<1 THEN RR=1
  173. 1906  IF T AND FNTI!>DE! THEN A$=".":GOSUB 1403:DE!=FNTI!+1
  174. 1910  IF R=>NMR THEN FC=M(1,2):GOSUB 21996:GOTO 1950
  175. 1915  IF MID$(R$,116,1)=CHR$(226) THEN 1946
  176. 1920  IF INSTR(MID$(R$,37,31),NAM$) OR (SH AND INSTR(MID$(R$,37,31),"SYSOP")) OR (SH AND INSTR(MID$(R$,37,31),NA$+" "+NB$)) THEN GOTO 1925 ELSE 1935
  177. 1925  IF T THEN A$="Mail may be FOR YOU":GOSUB 1399:T=0
  178. 1930  A$=LEFT$(R$,5):GOSUB 1403
  179. 1935  IF INSTR(MID$(R$,6,31),NAM$) OR (SH AND INSTR(MID$(R$,6,31),"SYSOP")) OR (SH AND INSTR(MID$(R$,6,31),NA$+" "+NB$)) THEN GOTO 1940 ELSE 1945
  180. 1940  IF DQ<128 THEN DQ=DQ+1:B$(DQ)=LEFT$(R$,5)
  181. 1945  LC=LC+1:M(LC,1)=R:M(LC,2)=VAL(MID$(R$,2,4))
  182. 1946  R=R+RR:GOTO 1905
  183. 1950  IF DQ=0 OR NOT RD THEN RETURN ELSE A$="Mail you may have left":GOSUB 1399
  184. 1960  FOR I=1 TO DQ:A$=B$(I):GOSUB 1403:NEXT:A$="Please <K>ill unneeded ones":GOSUB 1398:RETURN
  185. 2000  IF LC=ME THEN A$="Too many active messages!  Try tomorrow":GOSUB 1398:GOTO 3650
  186. 2006  PAS$="":SC=0:IF NOT RE THEN T$=""
  187. 2007  IF SC THEN Z$=CG$:FT$="comment" ELSE Z$=MES$:FT$="message
  188. 2008  IF SC THEN GOSUB 52000:GOTO 2009 ELSE AD$="2000":IF NMR+5=>HMR THEN AD$="1"
  189. 2009  IF VAL(AD$)<2000 THEN A$="No room for "+FT$:GOSUB 1405:GOTO 3650
  190. 2010  LI=0:L=0:X=0:FOR I=1 TO 30:A$(I)="":NEXT:IF SC THEN 2100
  191. 2020  IF RE THEN 2060 ELSE A$="To (C/R for All)":GOSUB 1499:IF LEN(B$(1))>30 THEN A$="30 Char. Max":GOSUB 1405:GOTO 2020
  192. 2030  IF Q=0 THEN T$="ALL" ELSE Z$=B$(1):GOSUB 5000:T$=Z$
  193. 2035  A$="Subject":GOSUB 1500:IF LEN(B$(1))>25 THEN A$="25 Char. Max":GOSUB 1405:GOTO 2035
  194. 2045  IF Q=0 THEN 20095 ELSE Z$=B$(1):GOSUB 5000:SUB$=Z$
  195. 2060  A$="Security:  K)ill, P)assword, R)eceiver, N)one, H)elp ":GOSUB 1500:IF Q=0 THEN 2060 ELSE Z$=LEFT$(B$(1),1):GOSUB 5000:ON INSTR("RKNPH",Z$) GOTO 2075,2090,2100,2088,2070:GOTO 2060
  196. 2070  F$=HE$(3):GOSUB 1790:GOTO 2060
  197. 2075  IF T$="ALL" THEN A$="Can't Protect Msg to ALL":GOSUB 1405:GOTO 2060
  198. 2077  IF INSTR(T$,"SYSOP") OR INSTR(T$,NA$+" "+NB$) THEN 2081
  199. 2079  IF NOT RE THEN TEA$=T$:FG=0:SUIX=UIX:GOSUB 12600:UIX=SUIX:GOSUB 21995:IF NOT FG THEN A$=T$+" is not an active user.":GOSUB 1397:GOTO 2020
  200. 2081  A$="Sending personal mail to "+T$:GOSUB 1405
  201. 2084  PAS$=TU$:GOTO 2100
  202. 2085  A$=P$:GOSUB 1500:IF Q=0 THEN 2085 ELSE IF LEN(B$(1))>L THEN A$=STR$(L)+" Chars. max":GOSUB 1405:GOTO 2085 ELSE IF L=15 AND MID$(B$(1),1,1)="!" THEN A$=P$+" can't begin with '!'":GOSUB 1405:GOTO 2085 ELSE RETURN
  203. 2088  A$="Must KNOW PASSWORD TO READ msg.  Use password":GOSUB 1500: IF NO THEN 2070 ELSE L=14:A1$="!":GOTO 2092
  204. 2090  L=15:A1$="
  205. 2092  GOSUB 2085:Z$=B$(1):GOSUB 5000:PAS$=A1$+Z$
  206. 2100  A$="Type "+FT$+" (C/R to end,"+STR$(LW)+" lines max)":GOSUB 1398:GOSUB 3200
  207. 2125  LI=LI+1:A$=RIGHT$(STR$(LI),2)+": "+A$(LI):GOSUB 1403:GOSUB 3700:IF A$(LI)="" THEN LI=LI-1:GOTO 2300
  208. 2140  J=LI:GOSUB 2200:IF X THEN 2300 ELSE 2125
  209. 2200  X=0:IF J<(LW-2) THEN RETURN ELSE A$=MID$("2 lines leftLast line   Full",12*(J-(LW-2))+1,12):X=(J>(LW-1))
  210. 2210  GOSUB 1405:RETURN
  211. 2300  GOSUB 1405:IF NOT XPR THEN GOSUB 50400
  212. 2315  A$="Subfunc <A,C,D,E,I,L,M,S,?>":GOSUB 1499:IF Q=0 THEN 2315 ELSE Z$=B$(1):GOSUB 5000
  213. 2325  IF Q>1 AND Z$<>"M"THEN L=VAL(B$(Q)):GOSUB 3320
  214. 2330  ON INSTR("ACDEILMS?",Z$) GOTO 2400,2340,2500,2600,2800,3000,3100,3400,2345:GOTO 2300
  215. 2340  GOSUB 3200:GOTO 2140
  216. 2345  F$=HE$(4):GOSUB 1790:GOTO 2315
  217. 2400  A$="Abort "+FT$:GOSUB 1499:IF NOT YES THEN 2300
  218. 2430  A$="Aborted":GOSUB 1398:GOTO 3650
  219. 2500  GOSUB 1405:IF Q=1 THEN A$="Delete ":GOSUB 1403:GOSUB 3300
  220. 2520  A$="Line #"+STR$(L):GOSUB 1405:A$=A$(L):GOSUB 1400:A$="Delete this line":GOSUB 1500:IF NOT YES THEN A$="NOT Deleted":GOSUB 1405:GOTO 2300
  221. 2550  LI=LI-1:FOR X=L TO LI:A$(X)=A$(X+1):NEXT:A$(LI+1)="":A$="Deleted Line #"+STR$(L):GOSUB 1405:GOTO 2300
  222. 2600  GOSUB 1405:IF Q=1 THEN GOSUB 3300
  223. 2620  A$="Line #"+STR$(L)+" is:"+RTN$+A$(L):GOSUB 1400:A$="Enter <Oldstring;New> or C/R":GOSUB 1405:B$(2)="":GOSUB 1500:IF Q=0 THEN 2300
  224. 2660  X=INSTR(1,A$(L),B$(1)):IF X=0 THEN 2710
  225. 2670  FF=LEN(B$(1)):JJ=LEN(B$(2)):IF FF=JJ THEN MID$(A$(L),X)=B$(2):GOTO 2620
  226. 2690  CC$=MID$(A$(L),X+FF):DF$=LEFT$(A$(L),X-1):A$(L)=DF$+B$(2)+CC$:GOTO 2620
  227. 2710  A$="String <"+B$(1)+"> not found in line"+STR$(L):GOSUB 1405:GOTO 2300
  228. 2800  IF LI=>LW AND NOT SH THEN A$="Message full":GOSUB 1405:GOTO 2920
  229. 2820  GOSUB 1405:IF Q=1 THEN A$="Before ":GOSUB 1403:GOSUB 3300
  230. 2830  LL=LI:K=LI-L:FOR X=L TO LI:B$(X+1-L)=A$(X):A$(X)="":NEXT:LI=L
  231. 2840  A$=RIGHT$(STR$(LI),2)+": ":GOSUB 1403:GOSUB 3700:IF A$(LI)="" THEN 2920
  232. 2870  LI=LI+1:J=LI+K-1:GOSUB 2200:IF X THEN 2920 ELSE 2840
  233. 2920  FOR X=1 TO K+1:A$(LI+X-1)=B$(X):NEXT:LI=LL+LI-L:GOTO 2300
  234. 3000  STI=-1:GOSUB 1405:IF Q=1 THEN L=1:A$="To: "+T$+" Re: "+SUB$:GOSUB 1405:GOSUB 3200
  235. 3020  FOR X=L TO LI:IF RET THEN 2300 ELSE A$=RIGHT$(STR$(X),2)+": "+A$(X)
  236. 3030  GOSUB 1405:NEXT:GOTO 2300
  237. 3100  GOSUB 1405:IF Q<>1 THEN B$(1)=B$(Q):GOTO 3130
  238. 3115  A$="SET Right-Margin from"+STR$(MQ)+" TO (8...72)":GOSUB 1500:IF LEN(B$(1))>2 THEN 3140
  239. 3130  X=VAL(B$(1)):IF X>7 AND X<81 THEN MQ=X:A$="Margin now"+STR$(MQ):GOTO 3150
  240. 3140  A$="Invalid - Margin UNCHANGED"
  241. 3150  GOSUB 1405:IF MS THEN RETURN ELSE 2300
  242. 3200  A$="    ["+STRING$(MQ-2,45)+"]":GOTO 1398
  243. 3300  A$="Line #":GOSUB 1500:L=VAL(B$(1))
  244. 3320  IF L=>1 AND L=<LI THEN RETURN
  245. 3330  IF Q=0 THEN RETURN 2300
  246. 3340  A$="No such line":GOSUB 1405:RETURN 2300
  247. 3400  IF SC THEN 1850
  248. 3405  GOSUB 4910:DF$=R$:A$="Adding new msg #"+STR$(LE+1):GOSUB 1403:REC=0:N$="":LE=LE+1:LC=LC+1:MT$=STR$(LE)+SPACE$(5-LEN(STR$(LE))):IF PAS$=TU$ THEN MID$(MT$,1,1)="*
  249. 3460  FI$=FNS$(NAM$,31):T$=FNS$(T$,31):MID$(T$,23,8)=TIME$:SUB$=FNS$(SUB$,25):PAS$=FNS$(PAS$,15):FOR J=1 TO LI:A$(J)=A$(J)+CHR$(227):REC=REC+LEN(A$(J)):NEXT:IF REC MOD 128=0 THEN N$=STR$(REC\128+1) ELSE N$=STR$(REC\128+2)
  250. 3530  GET 1,NMR:M(LC,1)=NMR:M(LC,2)=LE:LSET R$=MT$+FI$+T$+D$+SUB$+PAS$+CHR$(225)+N$:PUT 1,NMR:NMR=NMR+VAL(N$):N$="":FOR J=1 TO LI:A$=".":GOSUB 1403:N$=N$+A$(J):IF LEN(N$)>127 THEN LSET R$=N$:PUT 1:N$=MID$(N$,129)
  251. 3630  NEXT:IF LEN(N$)>0 THEN LSET R$=N$:PUT 1
  252. 3640  GOSUB 1405:LSET R$=DF$:GOSUB 24000:GOSUB 21996
  253. 3650  IF RE THEN 30500 ELSE 20095
  254. 3700  RS$=A$(LI):COL=LEN(RS$):STI=0
  255. 3720  COL=COL+1
  256. 3730  IF LJ THEN X$=INPUT$(1):GOTO 3740
  257. 3732  TCC!=FNTI!:WHILE EOF(3):MMM!=FNTI!-TCC!:IF MMM!>TY THEN 10595
  258. 3733  GOSUB 42000:X$=INKEY$:FK$=X$:GOSUB 60000:IF LEN(X$)=1 THEN 3740
  259. 3736  WEND:X$=INPUT$(1,3):IF X$=LF$THEN 3730
  260. 3738  IF X$=CHR$(127)THEN 3870
  261. 3740  IF X$=CHR$(8) OR X$=CHR$(7) OR X$=CHR$(26) OR X$=CHR$(227) THEN 3870
  262. 3750  A$=X$:GOSUB 1403:IF X$=CR$THEN 3850
  263. 3770  IF COL>MQ-3 AND X$=" " THEN GOSUB 1405:GOTO 3860
  264. 3780  RS$=RS$+X$:IF COL<MQ+1 THEN 3720
  265. 3800  Z=LEN(RS$):FOR I=1 TO LEN(RS$):IF MID$(RS$,Z,1)=" " THEN 3820
  266. 3810  Z=Z-1:NEXT:Z=LEN(RS$)-1
  267. 3820  COL=MQ+1-Z:IF PRT THEN PRINT STRING$(COL,29);STRING$(COL,0);
  268. 3830  IF NOT LJ THEN PRINT#3,STRING$(COL,8);STRING$(COL,32);
  269. 3840  A$(LI)=LEFT$(RS$,Z):A$(LI+1)=RIGHT$(RS$,COL):GOTO 2210
  270. 3850  IF NOT LJ AND LF THEN PRINT#3,LF$;
  271. 3860  A$(LI)=RS$:RETURN
  272. 3870  IF COL=1 THEN 3730 ELSE COL=COL-2:RS$=LEFT$(RS$,LEN(RS$)-1)
  273. 3880  IF PRT THEN PRINT BK1$;
  274. 3885  IF NOT LJ THEN PRINT#3,BK$;
  275. 3890  GOTO 3720
  276. 3900  KB=0:GOSUB 1405:IF Q<>1 THEN MM=VAL(B$(Q)):GOTO 3950
  277. 3930  A$="Msg # to Kill":GOSUB 1500:MM=VAL(B$(Q)):GOSUB 1405
  278. 3950  FOR QX=1 TO LC:IF M(QX,2)=MM AND MM>=1 THEN 3970
  279. 3955  NEXT:GOSUB 3965:GOTO 4040
  280. 3965  A$="No such msg #"+STR$(MM):GOTO 2210
  281. 3970  GOSUB 21990:GET 1,M(QX,1):R=VAL(MID$(R$,118)):IF SH THEN 4030
  282. 3980  Z=15:Z$=MID$(R$,101,15):GOSUB 8100:IF LEN(Z$)=0 THEN 4030
  283. 3990  IF Z$=TU$ THEN IF INSTR(R$,NAM$) THEN 4030 ELSE MES=-1:MR=0:GOSUB 680:GOSUB 25000:GOTO 4040
  284. 4000  IF LEFT$(Z$,1)="!" THEN Z$=MID$(Z$,2)
  285. 4010  KEE$=FNS$(Z$,15):MR=1:MES=-1:GOSUB 667:IF PF THEN GOSUB 25000:GOTO 4040
  286. 4030  LSET R$=LEFT$(R$,115)+CHR$(226)+MID$(R$,117):PUT 1,LOC(1):A$="Killed Msg # "+STR$(MM):GOSUB 1405:GOSUB 25000
  287. 4040  IF KB THEN RETURN ELSE 20095
  288. 4100  LF=NOT LF:A$="Line Feeds "+MID$("OffOn",1-3*LF,3):GOSUB 1496:GOTO 2210
  289. 4200  BA=NOT BA:A$="Prompting Bell "+MID$("OffOn",1-3*BA,3):GOTO 2210
  290. 4240  XPR=NOT XPR:A$=MID$("NoviceExpert",1-6*XPR,6):GOTO 2210
  291. 4320  QU=-1:RT=0:SU=0:GOTO 4350
  292. 4330  QU=0:RT=-1:SU=0:GOTO 4350
  293. 4340  QU=0:RT=0:SU=-1<UNK! {0009}>
  294. 4350  GOSUB 30500:QAH=-RT-QU-SU*5:IF Q>2 AND VAL(B$(Q))=0 THEN Z$=B$(Q):Q=Q-1 ELSE Z$=""
  295. 4360  GOSUB 5000:LG$(15)=Z$:LL=1:LI=Q:MU=0
  296. 4370  LL=LL+1:IF LL<=LI THEN MM=VAL(B$(LL)):GOTO 4415
  297. 4380  NH=0:MU=0:A$="Msg # ("+STR$(FC)+" to"+STR$(M(LC,2))+", *, <H>elp)":IF XPR THEN 4400
  298. 4390  IF RT THEN A$=A$+" to Retrieve (C/R to end)" ELSE A$="Starting at "+A$
  299. 4400  GOSUB 1500:IF Q=0 THEN 20095 ELSE IF INSTR("Hh",LEFT$(B$(1),1))THEN F$=HE$(7):GOTO 1790 ELSE LL=0:LI=Q:GOTO 4370
  300. 4415  FOW=0:REV=0:IF B$(LL)="*"THEN MM=LO+1:FOW=-1:GOTO 4430
  301. 4416  IF INSTR("Mm",B$(LL)) THEN MU=-1:GOTO 4370 ELSE IF MM=0 THEN 20095 ELSE GOSUB 1405
  302. 4430  IF RIGHT$(B$(LL),1)="+"THEN FOW=-1 ELSE IF RIGHT$(B$(LL),1)="-"THEN REV=-1:GOTO 4490
  303. 4450  FOR R=1 TO LC:IF RT AND M(R,2)=MM THEN 4520
  304. 4470  IF((RT AND FOW)OR QU OR SU)AND M(R,2)=>MM THEN 4520
  305. 4480  NEXT:GOTO 4515
  306. 4490  FOR R=LC TO 1 STEP-1:IF M(R,2)<=MM THEN 4540
  307. 4510  NEXT
  308. 4515  GOSUB 3965:GOTO 4370
  309. 4520  CK=R:IF RT AND NOT FOW THEN 4560
  310. 4530  QQ=R:CK=LC:SO=1:GOTO 4550
  311. 4540  QQ=R:CK=1:SO=-1
  312. 4550  FOR R=QQ TO CK STEP SO
  313. 4560  GET 1,M(R,1):PF=0:UH=0:Z$=MID$(R$,101,15):X=1
  314. 4561  FF=INSTR(MID$(R$,X),NAM$):IF FF THEN X=LEN(NAM$)+FF:IF (FF<7 OR MID$(R$,FF-1,1)=" ") AND (X>66 OR MID$(R$,X,1)=" ") THEN UH=-1 ELSE IF FF<37 THEN X=37:GOTO 4561
  315. 4562  IF NOT SH THEN IF INSTR(R$,TU$)>0 AND NOT UH THEN PF=-1:IF FOW OR REV THEN 4635
  316. 4563  MM=VAL(MID$(R$,2,4)):IF MU AND NOT UH THEN 4625
  317. 4580  IF INSTR(R$,LG$(15))=0 THEN 4635
  318. 4581  IF MID$(R$,116,1)=CHR$(226) THEN 4630
  319. 4582  PG=0:IF MID$(Z$,1,1)="!" THEN IF NOT SH THEN PG=-1:KEE$=MID$(Z$,2)+" ":MR=0:GOSUB 665
  320. 4584  IF PF AND (QU OR (SU AND NOT PG)) THEN 4635
  321. 4585  IF PF THEN IF PG THEN SJ$="<PASSWORD>" ELSE SJ$="<PROTECTED>" ELSE SJ$=MID$(R$,76,25)
  322. 4590  IF QU THEN Z$=LEFT$(R$,5)+" "+SJ$:Z=31:GOSUB 8100:A$=Z$:GOSUB 1405:GOTO 4630
  323. 4600  GOSUB 8000:IF SU OR RET THEN 4630 ELSE IF M(R,2)>LO THEN LO=M(R,2)
  324. 4610  IF NOT PF THEN 4613 ELSE IF PG THEN MR=2:GOSUB 667
  325. 4611  IF PF THEN 4625
  326. 4613  GOSUB 9000:GOSUB 1405:IF Q=0 OR PL=0 THEN 4625
  327. 4614  GOSUB 41000:KB=0:RE=0:IF NH THEN 4625
  328. 4616  A$=LG$(0)+MID$(",K",1,-UH*2):GOSUB 1500:IF NO THEN 4650
  329. 4618  IF KB AND (UH OR SH) THEN IF UG>=MD(10) THEN GOSUB 62520:GOSUB 3950:GOSUB 62530:GOTO 4625 ELSE RS$="MMenu R) Func 10":GOSUB 1380:GOTO 4625
  330. 4620  IF NOT RE THEN 4625
  331. 4621  IF UG<MD(4) THEN RS$="MMenu R) Func 4":GOSUB 1380:RE=0:GOTO 4625 ELSE IF LEFT$(SUB$,3)<>"(R)" THEN SUB$="(R)"+LEFT$(SUB$,22)
  332. 4622  T$=FI$:FI$=NAM$:GOSUB 62520:GOSUB 2000:RE=0:GOSUB 62530:GOTO 4560
  333. 4625  IF NOT FOW AND NOT REV THEN 4370
  334. 4630  IF PL=0 THEN 4631 ELSE Q=Q+QAH:IF Q<PL THEN 4631 ELSE GOSUB 5600:IF NO THEN Q=0:GOTO 4650 ELSE Q=QAH
  335. 4631  GOSUB 42010:IF RET THEN 20095
  336. 4635  NEXT:IF RT THEN 4370
  337. 4650  GOSUB 1405:A$="End of Msgs":GOSUB 1405:GOTO 20095
  338. 4700  IF NOT AVA GOTO 4708
  339. 4705  A$="Chat. Remote Conversation":GOSUB 1399:JJ=FNV(TIME$,1)*100+FNV(TIME$,4):IF(JJ>AA AND JJ<AB)OR AC THEN 4710
  340. 4707  GOTO 4750
  341. 4708  A$="SYSOP in from"+STR$(AA)+" to"+STR$(AB)+",":GOSUB 1405:GOTO 4755
  342. 4710  K=0:A$="Paging SYSOP now":GOSUB 1403:TCC!=FNTI!+30
  343. 4730  TCA!=FNTI!+1
  344. 4731  IF FNTI!<TCA! THEN GOTO 4731
  345. 4735  K=K+1:IF INKEY$=ESC$ THEN 4765 ELSE A$=". "
  346. 4740  IF K MOD 2 THEN A$=A$+CHR$(7):IF LEN(PA$)=3 THEN IF LH THEN LPRINT CHR$(7);
  347. 4745  GOSUB 1403:IF FNTI!<TCC!GOTO 4730 ELSE GOSUB 1405
  348. 4750  A$="SYSOP in from"+STR$(AA)+" to"+STR$(AB)+", but not now":GOSUB 1397
  349. 4755  A$="Please leave msg/comment":Z$="Paged at "+LEFT$(TIME$,5):GOSUB 13670:GOTO 2210
  350. 4765  A$="SYSOP here! Go ahead":GOSUB 1399
  351. 4770  CM=-1:CHT!=FNTI!:GOSUB 49000
  352. 4775  WHILE EOF(3):A$=INKEY$:FK$=A$:GOSUB 60000:IF A$=CHR$(8) OR A$=CHR$(7) OR A$=CHR$(26) OR A$=CHR$(227) OR A$=CHR$(127)THEN 4805 ELSE IF A$=ESC$THEN CM=0:CLS:CH!=FIX(FNTI!-CHT!)+CH!:GOTO 4820
  353. 4785  IF A$=CR$AND LF THEN PRINT#3,LF$;
  354. 4790  IF A$<>"" THEN 4800
  355. 4795  WEND
  356. 4797  A$=INPUT$(1,3):IF A$=CHR$(8) OR A$=CHR$(7) OR A$=CHR$(26) OR A$=CHR$(227) THEN 4805 ELSE IF A$=CR$AND LF THEN PRINT#3,LF$;
  357. 4800  GOSUB 1403:GOTO 4775
  358. 4805  IF POS(0)>1 THEN PRINT BK1$;:PRINT#3,BK$;
  359. 4810  GOTO 4775
  360. 4820  IF AM$="U" THEN RETURN 1330 ELSE IF AM$="F" THEN RETURN 20015 ELSE 20095
  361. 4850  A$="RBBS-PC Ver "+VA$+" Node "+ND$:GOSUB 1398:IF NOT GRF THEN A$="Caller # "+STR$(CJ#)+"  "
  362. 4855  A$=A$+"# active msgs:"+STR$(LC)+"  Next msg #"+STR$(LE+1):LO=-LO*(LO<=LE):IF LO>0 THEN A$=A$+"  Last msg read:"+STR$(LO)
  363. 4857  GOSUB 1399:IF SH THEN A$="USERS: used"+STR$(NUR-1)+" room for"+STR$(HUR+1-NUR)+"  MESSAGES: used"+STR$(LC)+" room for"+STR$(ME-LC):GOSUB 1399
  364. 4860  GOTO 2210
  365. 4900  GRF=-1:A$="Welcome to "+GRN$:GOSUB 1405
  366. 4910  GOSUB 21990:IF LOF(1)=0 THEN DF$=MES$:CLOSE 1:KILL MES$:GOSUB 25000:GOTO 13600 ELSE GOTO 23000
  367. 5000  FOR Z=1 TO LEN(Z$):MID$(Z$,Z,1)=CHR$(ASC(MID$(Z$,Z,1))+32*(ASC(MID$(Z$,Z,1))>96)):NEXT:RETURN
  368. 5100  X$="":FOR Z=1 TO LEN(Z$):IF ASC(MID$(Z$,Z,1))<65 OR ASC(MID$(Z$,Z,1))>90 THEN 5105 ELSE X$=X$+MID$(Z$,Z,1)
  369. 5105  NEXT:Z$=X$:RETURN
  370. 5110  A$="Enter new password":GOSUB 45010:IF Q=0 THEN RETURN ELSE IF LEN(B$(1))>15 OR B$(1)=SPACE$(LEN(B$(1))) THEN 5110 ELSE Z$=B$(1):GOSUB 5000
  371. 5120  A$="Reenter new password":GOSUB 45010:IF Q=0 THEN RETURN ELSE SWAP Z$,B$(1):GOSUB 5000:IF Z$<>B$(1)THEN A$="Don't match!":GOTO 2210
  372. 5125  IF MP AND NCH>MP AND NOT SH THEN A$="No changes permitted" ELSE Z=1:GOSUB 5140:IF NOT FG THEN 5130 ELSE A$="Temporary change":PW$=X$:TV!=TJA*60:UG=TFA:GOSUB 41070:SH=(UG>=SE)
  373. 5126  Z$="Used temp pswd "+B$(1):GOSUB 13670:GOTO 2210
  374. 5130  GOSUB 21997:GET 2,UIX:LSET PW$=B$(1):PUT 2,UIX:CLOSE 2:GOSUB 27500:A$="Pswd changed":STI=0:GOSUB 1398:IF MP THEN NCH=NCH+1
  375. 5131  Z$="New Password "+B$(1):GOTO 13670
  376. 5140  FG=0:CLOSE 2:OPEN PD$ FOR INPUT AS 2:Z$=FNS$(Z$,15)
  377. 5150  IF EOF(2) THEN 5160 ELSE INPUT #2,X$,TFA,TJA:IF LEN(X$)>15 THEN 5150 ELSE X$=FNS$(X$,15):IF Z$<>X$ THEN 5150 ELSE IF Z THEN FG=-1 ELSE IF UG=TFA THEN FG=-1 ELSE 5150
  378. 5160  RETURN
  379. 5200  IF Q>1 THEN 5230
  380. 5220  A$="CHANGE page length from"+STR$(PL)+" TO (0=continuous)":GOSUB 1500:IF Q=0 THEN 1200
  381. 5230  A=VAL(B$(Q)):IF A<0 OR A>255 THEN 5220 ELSE PL=A:GOTO 1200
  382. 5300  NAME CQ$ AS CQ$
  383. 5310  IF NOT XPR THEN F$=CQ$:GOSUB 43025 
  384. 5315  A$="Conference Func <J,M,Q,X>":GOSUB 1500:IF Q=0 THEN 2210 ELSE Z$=B$(1):GOSUB 5000:IF Z$="X" THEN GOSUB 4240:GOTO 5310 ELSE FF=INSTR("JMQ",Z$):IF FF=0 THEN 5310 ELSE ON FF GOTO 5320,5350,2210
  385. 5320  A$="Enter conference name":GOSUB 1500:IF Q=0 THEN 5310
  386. 5323  GRN$=B$(1):MES$=MID$(MB$,1,2)+GRN$+"M.DEF":NAME MES$ AS MES$
  387. 5325  IF NAM$<>"SYSOP" THEN IF NOT (GRF AND (UF$=UF1$)) THEN GOSUB 26000:GOSUB 9400:GET 2,UIX:GOSUB 9600:PUT 2,UIX:GOSUB 27000
  388. 5327  UF$=MID$(UF$,1,2)+GRN$+"U.DEF":NAME UF$ AS UF$
  389. 5330  IF NAM$="SYSOP" THEN 5345 ELSE TEA$=NAM$:GOSUB 12600:GOSUB 21995
  390. 5340  IF FG THEN UIX=LOC(2):TIX=UIX:GOSUB 9500:GOTO 5345 ELSE A$="conference unavailable to you":GOSUB 1397:GRN$="":UIX=MUIX:UF$=UF1$:MES$=MB$:GOSUB 30500:GOSUB 23000:GRF=0:GOTO 2210
  391. 5345  GRN$=GRN$+" Conference"+RTN$:GOSUB 4900:GOSUB 25000:RETURN 900
  392. 5350  GRN$="":IF NAM$="SYSOP" THEN MES$=MB$:UF$=UF1$:GRF=0:GOSUB 1900:GOTO 2210
  393. 5360  IF GRF AND (UF$<>UF1$) THEN GOSUB 26000:GOSUB 9400:GET 2,TIX:GOSUB 9600:PUT 2,TIX:GOSUB 27000
  394. 5362  IF GRF THEN MES$=MB$:UF$=UF1$:GRF=0:GOSUB 9400:UIX=MUIX:GET 2,UIX:GOSUB 9500:GOSUB 1900:GOTO 2210 ELSE GOTO 2210
  395. 5400  A$="Your PROFILE (utilities reset)":GOSUB 1399:XPR=NOT XPR:GOSUB 4240:GOSUB 43020:FF=INSTR("AMX",LG$(20)):FF=FF-4*(FF<1):GOSUB 42810:UC=NOT UC:GOSUB 42960:LF=NOT LF:GOSUB 4100:GOSUB 42720:BA=NOT BA:GOTO 4200
  396. 5500  IF BPS<>-1 THEN A$="only 300 baud can change speed":GOTO 1397
  397. 5507  A$="Change to 450 baud":GOSUB 1500:IF NOT YES THEN RETURN
  398. 5510  A$="Change. Then press <C/R> until I respond":GOSUB 1405:FOR I=1 TO 3:GOSUB 50510:NEXT:C=0:SWAP Q,NE:GOSUB 1654:SWAP Q,NE
  399. 5530  C=C+1:GOSUB 42000:IF C=20 THEN 10595 ELSE GOSUB 50500
  400. 5535  IF NOT EOF(3)THEN IF ASC(INPUT$(1,3))=13 THEN 5540
  401. 5537  GOTO 5530
  402. 5540  Z$="Changed to 450 baud":GOSUB 13670:A$=Z$:GOSUB 1405:BPS=-2:RETURN
  403. 5600  GOSUB 41000:IF NH THEN RETURN ELSE A$=LEFT$(LG$(0),13):GOSUB 1500:RETURN
  404. 6000  IF STI THEN A$="* <Ctrl K> or <Ctrl X> aborts <Ctrl S> suspends *":GOSUB 1399
  405. 6020  CK=0:GOTO 7100
  406. 6030  Q=-1:CK=0:GOTO 7110
  407. 6080  A$="Missing file "+F$+TT$:GOTO 2210
  408. 7000  A$="Scanning "+MID$(F$,3,INSTR(F$,".")-3)+" for "+A1$:GOSUB 1405:PG=-1
  409. 7100  CLOSE 2:OPEN "I",2,F$:Q=0:FF=PL-1
  410. 7110  IF EOF(2)OR(INP(MSR)<128 AND NOT LJ)THEN 7260
  411. 7120  IF PL AND Q>=0 THEN IF Q>=FF THEN GOSUB 5600:IF NO THEN 7260 ELSE Q=0
  412. 7130  LINE INPUT #2,A$:IF CK=0 THEN 7250
  413. 7157  IF CK>1 THEN Z$=A$:GOSUB 5000:XXX=(INSTR(Z$,RS$)=0):GOTO 7190
  414. 7160  A=INSTR(9,MID$(A$,1,32),"/"):IF A=0 THEN A=INSTR(9,MID$(A$,1,32),"-")
  415. 7162  IF A<3 THEN 7110 ELSE IF INSTR("0123456789",MID$(A$,A-1,1))=0 THEN 7110 ELSE A=A-2:KEE$=FNDC$(MID$(A$,A,8)):IF MID$(KEE$,3,1)=" " THEN MID$(KEE$,3,1)="0
  416. 7185  IF MID$(KEE$,5,1)=" " THEN MID$(KEE$,5,1)="0
  417. 7189  XXX=(KEE$<RS$)
  418. 7190  IF XXX THEN 7110 ELSE IF PG THEN PG=0:CLOSE 2:OPEN "I",2,F$:Q=0:GOTO 7110
  419. 7200  IF PG THEN 7110
  420. 7250  GOSUB 1405:Q=Q-(Q>=0):IF NOT RET THEN 7110
  421. 7260  A$="":Q=0:CLOSE 2:GOSUB 42000:RETURN
  422. 8000  GOSUB 1405:IF RET THEN RETURN
  423. 8020  IF MID$(R$,37,5)="ALL  " THEN T$="ALL":GOTO 8040
  424. 8030  Z=22:Z$=MID$(R$,37,Z):GOSUB 8100:T$=Z$
  425. 8040  Z=25:Z$=MID$(R$,76,Z):GOSUB 8100:SUB$=Z$:IF PF THEN SUB$=SJ$
  426. 8050  Z=31:Z$=MID$(R$,6,Z):GOSUB 8100:FI$=Z$:A$="Msg # "+LEFT$(R$,5)+" Dated "+MID$(R$,68,8)+" "+MID$(R$,59,8):IF NOT RET THEN A$=A$+RTN$+" From: "+FI$+RTN$+"   To: "+T$+RTN$+"   Re: "+SUB$
  427. 8080  GOTO 2210
  428. 8100  Z=LEN(Z$):FOR I=1 TO LEN(Z$):IF MID$(Z$,Z,1)<>" " THEN 8110
  429. 8105  Z=Z-1:NEXT
  430. 8110  Z$=MID$(Z$,1,Z):RETURN
  431. 9000  GOSUB 1405:Q=4:FOR X=2 TO VAL(MID$(R$,118)):GOSUB 1403:EOL=0:J=1:GET 1
  432. 9050  B=INSTR(J,R$,CHR$(227)):IF RET THEN RETURN
  433. 9060  C=B-J:IF C<0 THEN C=128:EOL=-1
  434. 9070  A$=MID$(R$,J,C):IF EOL THEN 9090
  435. 9085  J=B+1:GOSUB 57100:GOTO 9050
  436. 9090  NEXT:A$="":RETURN
  437. 9100  GOSUB 1405:GOSUB 9140:GOSUB 41510:A$="Now "+TIM$+"  Time on: ":IF HHH>0 THEN A$=A$+STR$(HHH)+" Hrs"
  438. 9110  A$=A$+STR$(MMM)+" Min &"+STR$(SSS)+" Sec":GOTO 1405
  439. 9140  H=FNV(TI$,1):M=FNV(TI$,4):S=FNV(TI$,7):HH=FNV(TIME$,1):MM=FNV(TIME$,4):JJ=FNV(TIME$,7):IF S=<JJ THEN SSS=JJ-S ELSE SSS=60-(S-JJ):M=M+1
  440. 9150  IF M=<MM THEN MMM=MM-M ELSE MMM=60-(M-MM):H=H+1
  441. 9160  IF H=<HH THEN HHH=HH-H:RETURN ELSE HHH=24-(H-HH):RETURN
  442. 9400  CLOSE 2:OPEN "R",2,UF$,128:FIELD 2,31 AS NM$,15 AS PW$,2 AS SL$,14 AS OP$,24 AS CS$,19 AS MA$,14 AS TD$,3 AS LND$,2 AS UDL$,2 AS UUL$,2 AS ET$:FIELD #2,128 AS HU$:RETURN
  443. 9500  UG=CVI(SL$):LO=CVI(MID$(OP$,3,2)):LG$(20)=MID$(OP$,5,1):GR=VAL(MID$(OP$,6,1)):LG$(19)=MID$(" GC",GR+1,-(GR>0)):MQ=CVI(MID$(OP$,7,2))
  444. 9510  FF=CVI(MID$(OP$,9,2)):BA=FNBT(FF,1):XPR=FNBT(FF,2):NK=FNBT(FF,4):UC=FNBT(FF,8):LF=FNBT(FF,16):PL=ASC(MID$(OP$,13))
  445. 9520  NUL$=MID$(STRING$(5,0),1,-5*NK):GOSUB 1496:RETURN
  446. 9600  LSET OP$=MKI$(TGA)+MKI$(LO)+LG$(20)+MID$(STR$(GR),2,1)+MKI$(MQ)+MKI$(-BA-2*XPR-4*NK-8*UC-16*LF)+MKI$(0)+CHR$(PL)+STRING$(1,0):RETURN
  447. 9700  IF BC<1 THEN A$="no bulletins today":GOTO 1397
  448. 9705  F$=LG$(8):GOSUB 1790
  449. 9707  GOSUB 41000:NH=0:A$="Bulletin # 1 thru"+STR$(BC)+", L)ist, C/R continues":GOSUB 1499:IF Q=0 THEN 1405
  450. 9708  IF B$(1)="L" OR B$(1)="l" THEN 9705
  451. 9711  Z$=B$(1):IF VAL(Z$) >0 AND VAL(Z$) <=BC THEN 9720 ELSE 9705
  452. 9720  GOSUB 5000:F$=LG$(7)+Z$:STI=-1:GOSUB 1790:STI=0:GOSUB 41050:GOTO 9707
  453. 9800  IF GRF THEN A$="Nodes won't display within a conference!":GOTO 1400 ELSE GOSUB 1405:GOSUB 30500:FOR X=2 TO MG+1:GET 1,X:A$=MID$(R$,1,31)+"Node"+STR$(X-1)+LEFT$(" in",1-2*(MID$(R$,57,1)<>"A"))+"active":GOSUB 1405:NEXT:RETURN
  454. 10070  F$=CG$:GOSUB 6000:RETURN
  455. 10090  A$="List - <U>sers, <R>ecent callers, C/R quits":GOSUB 1499:IF Q=0 THEN RETURN ELSE Z$=B$(1):GOSUB 5000:ON INSTR("UR",Z$)+1 GOTO 10090,10096,10100
  456. 10096  GOSUB 12700:GOSUB 9400:STI=-1:Q=0:FOR I=1 TO HUR-1:GET 2,I:IF ASC(NM$)=0 OR LEFT$(NM$,3)="   " THEN 10099 ELSE A$=LEFT$(NM$,20)+CS$+MA$+TD$:GOSUB 1405:IF RET THEN RETURN ELSE GOSUB 57110
  457. 10099  NEXT:STI=0:RETURN
  458. 10100  F$=CF$:GOTO 57000
  459. 10390  A$="Recover Msg #":GOSUB 1500:MM=VAL(B$(1)):IF MM<1 THEN 1450
  460. 10410  R=FMR:GOSUB 1405:GOSUB 30500
  461. 10420  GET 1,R:RR=VAL(MID$(R$,118)):IF R=>NMR THEN A$="No Msg #"+STR$(MM):GOTO 2210
  462. 10440  IF VAL(MID$(R$,2,4))<>MM THEN R=R+RR:GOTO 10420
  463. 10450  IF INSTR(R$,CHR$(226))<>0 THEN GOSUB 22000:LSET R$=LEFT$(R$,115)+CHR$(225)+MID$(R$,117):PUT 1,LOC(1):GOSUB 25000:A$="Restored Msg #"+STR$(MM):GOSUB 1405:GOTO 10490
  464. 10480  A$="Msg #"+STR$(MM)+" not Dead":GOTO 2210
  465. 10490  A$="Re-Loading Msg File":GOSUB 1405:GOSUB 1900:GOTO 2210
  466. 10530  A$="Delete comments":GOSUB 1500:IF YES THEN CLOSE 2:OPEN "O",2,CG$:CLOSE 2
  467. 10550  GOTO 20095
  468. 10553  IF DAY THEN A$="Daily time limit exceeded!  Try tomorrow":GOSUB 1405
  469. 10555  IF KG THEN RETURN
  470. 10560  GOSUB 9100:A$=FE$+", Thanks for calling!":GOSUB 1405
  471. 10595  IF UIX<1 THEN CLS:GOTO 13540
  472. 10597  GOSUB 13700:IF GRF AND (UF$<>UF1$) THEN GOSUB 21997:GET 2,TIX:GOSUB 9600:PUT 2,TIX:GOSUB 27500
  473. 10598  IF GRF THEN MES$=MB$:UF$=UF1$:UIX=MUIX:GOSUB 9400:GET 2,UIX:GOSUB 9500
  474. 10600  SH=0:GOSUB 21997:GET 2,UIX:GOSUB 9600:IF LD THEN LSET LND$=FNCD$(D$)
  475. 10605  LSET UDL$=MKI$(DLD):LSET UUL$=MKI$(ULD):GOSUB 41010:LSET ET$=MKI$(ET+(TV!/60)-TR!):PUT 2,UIX:GOTO 13540
  476. 10620  Z$=LG$(I):GOSUB 13670:Z$=NAM$+" on at "+D$+", "+TIM$+"** LOGON DENIED **, "+PE$:NG$=FNS$(Z$,128):GOSUB 13674
  477. 10698  A$="Access denied!":GOSUB 1399:GOTO 13540
  478. 10720  CLS:FILES B$(J):X=CSRLIN:LL=18+5*CE:FF=2+CE:LOCATE FF,1,1:LG$(21)=FNS$(DIR$,8):FOR I=FF TO X:FOR B=1 TO 66 STEP LL:G=G+1:B$(G)="":FOR QQ=0 TO 7:H=SCREEN(I,(B+QQ)):B$(G)=B$(G)+CHR$(H):NEXT
  479. 10733  IF LN THEN IF (LG$(13)="YES" AND B$(G) = LG$(21)) OR (LG$(14)="YES" AND B$(G)=UB$) THEN G=G-1:GOTO 10840
  480. 10740  IF LEFT$(B$(G),1)=" " THEN G=G-1:RETURN
  481. 10840  NEXT:NEXT:RETURN
  482. 10925  MS=-1:GOSUB 3100:MS=0:RETURN
  483. 10930  IF DA<2 THEN A$="Requires DOS 2.0 up":GOTO 1200
  484. 10932  IF LJ THEN A$="Only for remote SYSOP's":GOTO 1200
  485. 10934  CLOSE 2:OPEN "O",2,CH$:PRINT#2,"ECHO OFF":PRINT#2,"CTTY ";CP$:PRINT#2,"ECHO RBBS-PC ";VA$:PRINT#2,"ECHO SYSOP in Remote Console Mode at ";TIME$;" on ";DATE$:PRINT#2,"COMMAND ":PRINT#2,"CTTY CON":PRINT#2,RC$:GOSUB 56000
  486. 10950  GOSUB 41500:Z$="Exited to DOS at "+TIM$:GOSUB 13670:GOTO 10992
  487. 10970  IF NOT WA THEN A$="All doors closed":GOSUB 1405:GOTO 20095
  488. 10973  F$=ME$(5):GOSUB 43025:IF UG<UDR THEN A$="You may not open a door":GOTO 1405
  489. 10974  A$="Open which door (C/R to end)":GOSUB 1500:Z$=B$(1):GOSUB 5000:IF B$(1)=""THEN RETURN
  490. 10976  CLOSE 2:OPEN "I",2,F$
  491. 10978  IF EOF(2)THEN A$="No such door "+Z$:GOSUB 1405:GOTO 1200 ELSE GOSUB 42010
  492. 10982  LINE INPUT#2,A$:IF LEN(A$)<LEN(Z$)GOTO 10978 ELSE IF INSTR(A$,Z$)=0 THEN 10978 ELSE Z$=Z$+".BAT
  493. 10986  NAME Z$ AS Z$
  494. 10987  CLOSE 2:OPEN "O",2,CH$:PRINT#2,Z$:PRINT#2,RC$:CLOSE 2:A$=Z$+" door opened at "+TIME$+" on "+DATE$:GOSUB 1405:WI=-1:GOSUB 56000:Z$=LEFT$(Z$,LEN(Z$)-4)+" door opened!":GOSUB 13670
  495. 10992  CLOSE 3:OUT MCR,INP(MCR)OR 1:IF WI THEN IF MC THEN DEF SEG=MC:GOSUB 60500:POKE(&H64+PEEK(&H58)+256*PEEK(&H59)+&HC),ASC(RIGHT$(CP$,1))-48:AX=&H700+MF:GOSUB 60510:AX=&HB01:BX=0:GOSUB 60510
  496. 10996  GOSUB 9140:GOSUB 43050:SYSTEM
  497. 11000  TU=UIX:STI=-1:I=1:JJ=0:A$="A)dd, L)st, P)rt, M)od, S)can users (C/R quits)":GOSUB 1500
  498. 11003  IF Q=0 THEN 20093 ELSE QQ=0:Z$=LEFT$(B$(1),1):GOSUB 5000:IF Z$="A"THEN 12300 ELSE IF Z$="M"THEN STI=0 ELSE IF Z$="P"THEN QQ=-1 ELSE IF Z$="S"THEN JJ=-1:STI=0 ELSE IF Z$<>"L" THEN 11000
  499. 11005  GOSUB 9400:Z=1:IF JJ THEN A$="Scan for N)ame, P)wd, C)ity/St, S)ystem or L)evel":GOSUB 1500:Z$=LEFT$(B$(1),1):GOSUB 5000:LG$(1)=Z$:CR=0:GOSUB 1405:GOSUB 12966:GOTO 12962
  500. 11010  FOR J=Z TO HUR-1:GET 2,J
  501. 11015  IF ASC(NM$)=0 OR LEFT$(NM$,3)="   " THEN 11300 ELSE OF=CVI(SL$):A$=STR$(LOC(2))+":"+NM$+" SECURITY "+STR$(OF)+" ":IF OF=<MO THEN A$=A$+" <Locked out>":GOTO 11100
  502. 11020  A$=A$+"Pw="+PW$+" Times on="+STR$(CVI(MID$(OP$,1,2)))
  503. 11025  IF QQ THEN LPRINT A$
  504. 11027  GOSUB 1405:RH=RET:IF OF>=SE THEN A$="  (SYSOP)   " ELSE A$=SPACE$(12)
  505. 11030  A$=A$+TD$+" "+CS$+MA$
  506. 11100  IF QQ THEN LPRINT A$
  507. 11101  GOSUB 1405:RH=RET:A$="  DOWNLOADS="+STR$(CVI(UDL$)):A$=FNS$(A$,30)+"UPLOADS="+STR$(CVI(UUL$)):A$=FNS$(A$,60)+"TIME USED="+STR$(CVI(ET$))+" Min":IF QQ THEN LPRINT A$
  508. 11105  GOSUB 1405:IF STI THEN 11300
  509. 11110  A$="D)elete, F)ind, M)enu, N)ew pwd, P)rint, Q)uit, S)ecurity, #)user":GOSUB 1500:IF NOT JJ AND Q=0 THEN 11310
  510. 11115  Z$=LEFT$(B$(1),1):GOSUB 5000:X=INSTR("DNPQFSM",Z$):IF Z$=""AND JJ THEN 12965 ELSE ON X GOTO 11130,11160,11220,11320,11340,11390,11330
  511. 11125  Z=VAL(B$):IF Z<1 OR Z>HUR-1 THEN 11310 ELSE 11010
  512. 11130  LSET NM$=STRING$(31,0):GOTO 11290
  513. 11160  GOSUB 12800:GOTO 11290
  514. 11220  QQ=NOT QQ:GOTO 11015
  515. 11290  UIX=LOC(2):GOSUB 26500:PUT 2,UIX:GOSUB 27500:UIX=0:GOTO 11015
  516. 11300  IF RH THEN 11330
  517. 11310  IF JJ THEN 12965 ELSE NEXT
  518. 11320  CLOSE 2:UIX=TU:GOTO 20095
  519. 11330  CLOSE 2:GOTO 11000
  520. 11340  A$="Full name to find":GOSUB 1499:Z$=B$(1):GOSUB 5000:IF Z$="" THEN 11340 ELSE TEA$=Z$:GOSUB 12600:GOSUB 21995:IF FG THEN 11015
  521. 11380  A$=TEA$+" not found":GOSUB 1400:GOTO 11310
  522. 11390  GOSUB 11395:LSET SL$=MKI$(OF):GOTO 11290
  523. 11395  A$="Enter security level":GOSUB 1500:Z$=B$(1):GOSUB 5000:OF=VAL(Z$):IF OF>UG THEN OF=UG:RETURN ELSE RETURN
  524. 12300  A1$="":TDA=0:UGH=UG:LG$(18)=FE$:LG$(21)=LK$:LG$(10)=NAM$:LG$(16)=CI$:GOSUB 12500:TEA$=NAM$:GOSUB 30500:GOSUB 12600:GOSUB 25000:IF UIX=0 THEN 12320 ELSE IF FG THEN PRINT "User already exists":GOSUB 27000:GOTO 12320
  525. 12310  GOSUB 12630:GOSUB 12800:GOSUB 11395:TFA=OF:GOSUB 12900:LSET TD$=D$+" "+TI$:GOSUB 12950:LSET CS$=Z$:LSET ET$=MKI$(0):PUT 2,UIX
  526. 12320  GOSUB 27500:UG=UGH:FE$=LG$(18):LK$=LG$(21):NAM$=LG$(10):CI$=LG$(16):UIX=TU:GOTO 11000
  527. 12500  IF TDA>5 THEN FF=-1:RETURN
  528. 12510  GOSUB 12700:TDA=TDA+1:A$=A1$+"FIRST Name":GOSUB 1499:IF Q=0 THEN 12500 ELSE Z$=B$(1):GOSUB 5000:GOSUB 5100:FE$=FNSS$(Z$):IF Q=1 THEN 12530
  529. 12520  Z$=B$(2):GOTO 12540
  530. 12530  A$=A1$+"LAST Name":GOSUB 1500:Z$=B$(1)
  531. 12540  GOSUB 5000:GOSUB 5100:LK$=FNSS$(Z$):IF LEN(FE$)<2 OR LEN(LK$)<2 OR (LEN(FE$)+LEN(LK$))>30 THEN 12500
  532. 12550  NAM$=MID$(FE$+" "+LK$,1,31):Z$=FE$:RETURN
  533. 12570  FG=0:CLOSE 2:OPEN LG$(18) FOR INPUT AS 2
  534. 12580  IF EOF(2) THEN 1495 ELSE INPUT #2,DF$:IF Z$<>DF$ THEN 12580 ELSE FG=-1:RETURN
  535. 12595  A$="Real name required.  Call traced & recorded.":GOSUB 1405:GOTO 10698
  536. 12600  GOSUB 4910:GOSUB 26000:A$="Checking Users...":GOSUB 1400:IF NUR>=HUR*0.95 THEN Z$="No room for new users":A$=Z$:GOSUB 13670:GOSUB 1397:UIX=0:FG=0:RETURN
  537. 12605  GOSUB 9400:X$=FNS$(TEA$,31):A$=FNS$("NEWUSER",31):DR$=SPACE$(31):DF=(ASC(MID$(TEA$,2,1))*10 + 7) MOD HUR:UIX=((ASC(TEA$)*100 + ASC(MID$(TEA$,LEN(TEA$)/2,1))*10 + ASC(RIGHT$(TEA$,1))) MOD HUR) + 1:IX=0
  538. 12610  GET 2,UIX:IF X$=NM$ THEN FG=-1:RETURN ELSE IF NM$=DR$ THEN UIX=IX-(IX=0)*UIX:FG=0:RETURN ELSE IF ASC(NM$)=0 OR NM$=A$ THEN IF IX=0 THEN IX=UIX
  539. 12620  UIX=UIX+DF:IF UIX>HUR-1 THEN UIX=UIX-HUR:GOTO 12610 ELSE 12610
  540. 12630  GOSUB 23000:NUR=NUR-(IX=0):GOSUB 24000:GOSUB 25000:GOSUB 26500:GOTO 27000
  541. 12700  IF GRF THEN A$="Users of "+GRN$+":":GOTO 1405 ELSE RETURN
  542. 12800  A$="Enter PASSWORD you'll use to logon again":GOSUB 1500:IF B$(1)=SPACE$(LEN(B$(1))) THEN 12800 ELSE IF LEN(B$(1))>15 THEN A$="15 Char. Max":GOSUB 1405:GOTO 12800 ELSE Z$=B$(1):GOSUB 5000:LSET PW$ = Z$:RETURN
  543. 12900  LSET NM$=NAM$:LSET OP$=MKI$(0)+MKI$(0)+" 0"+MKI$(64)+MKI$(16)+MKI$(0)+CHR$(P)+STRING$(1,0):LSET UDL$=MKI$(0):LSET UUL$=MKI$(0):LSET SL$=MKI$(TFA):LSET ET$=MKI$(0):RETURN
  544. 12950  A$="Type system calling from (C/R if "+SY$+")":GOSUB 1500:IF Q=0 THEN LSET MA$=SY$ ELSE Z$=B$(1):GOSUB 5000:LSET MA$=Z$
  545. 12960  A$=A1$+"CITY and STATE":GOSUB 1500:IF Q=0 THEN 12960 ELSE Z$=B$(1):GOSUB 5000:LSET CS$=Z$:CI$=Z$+SPACE$(2):RETURN
  546. 12962  X=0:FF=0:A$="String to search (C/R to end)":GOSUB 1500:Z$=B$(1):GOSUB 5000:R$=Z$:IF R$=""THEN 11000
  547. 12963  GET 2,I:GOSUB 12966:X=INSTR(LG$(4),R$):IF X>0 THEN 11015 ELSE IF I>HUR-1 THEN 11000
  548. 12965  I=I+1:X=0:GOTO 12963
  549. 12966  FF=INSTR("NCPSL",LG$(1)):IF FF=0 THEN 11000
  550. 12967  ON FF GOTO 12968,12969,12970,12971,12972
  551. 12968  LG$(4)=NM$:RETURN
  552. 12969  LG$(4)=CS$:RETURN
  553. 12970  LG$(4)=PW$:RETURN
  554. 12971  LG$(4)=MA$:RETURN
  555. 12972  LG$(4)=STR$(CVI(SL$)):RETURN
  556. 13000  IF ERR=7 THEN 13650
  557. 13010  IF ERL=180 AND ERR=63 THEN RESUME 187
  558. 13020  IF ERL=187 AND (ERR=24 OR ERR=25 OR ERR=27 OR ERR=68) THEN LH=0:RESUME 187
  559. 13022  IF ERL=324 AND ERR=57 THEN R1=INP(LSR):RESUME 324
  560. 13025  IF ERL=677 AND ERR=5 THEN RESUME 670
  561. 13033  IF ERL=825 AND ERR=5 THEN RESUME 830
  562. 13035  IF ERL=954 AND ERR=5 THEN HH=1:FH$="":RESUME 954
  563. 13036  IF ERL=1420 AND ERR=69 THEN GOSUB 13660:RESUME 13540
  564. 13037  IF ERL=1540 AND ERR=57 THEN RESUME 1540
  565. 13038  IF ERL=4370 AND ERR=6 THEN RESUME 1200
  566. 13045  IF ERL=5130 AND ERR=63 THEN RESUME 5160
  567. 13047  IF ERL=5150 AND ERR=62 THEN RESUME 5160
  568. 13050  IF ERL=13674 THEN LH=0:RESUME 13674
  569. 13060  IF ERL=11025 THEN QQ=0:RESUME 11025
  570. 13070  IF ERL=11100 THEN QQ=0:RESUME 11100
  571. 13087  IF ERL=20242 AND ERR=62 THEN RESUME 20247
  572. 13090  IF ERR=58 THEN 13130
  573. 13100  IF(ERR=EC AND(FNTI!-TKA!<5))THEN EA=EA+1:IF EA>10 THEN 50000
  574. 13120  EC=ERR:IF FNTI!-TKA!>5 THEN EA=0 ELSE TKA!=FNTI!
  575. 13130  IF ERL=117 AND ERR=53 THEN DF$=CA$:GOTO 13600
  576. 13135  IF ERL=121 AND ERR=62 THEN DF$=CA$:GOTO 13600
  577. 13140  IF ERL=220 THEN RESUME 220
  578. 13180  IF ERL=1420 AND ERR=57 THEN R1=INP(LSR):RESUME 1425
  579. 13190  IF ERL=1540 OR ERL=3736 OR ERL=20840 OR ERL=21280 OR ERL=21360 OR ERL=21420 THEN GOSUB 50500:IF INP(MSR)<128 THEN RESUME 10595
  580. 13200  IF ERL=1540 THEN RESUME 1540
  581. 13220  IF ERL=3736 THEN RESUME 3736
  582. 13230  IF ERL=4797 THEN GOSUB 50500:Z$=A$:GOSUB 13670:IF INP(MSR)<128 THEN RESUME 10595 ELSE RESUME 4797
  583. 13235  IF ERL=5140 AND ERR=53 THEN Z$="Missing file "+PD$:GOSUB 13670:IF Z=1 THEN Z$=B$(1):GOSUB 5000:RESUME 5160 ELSE RESUME 5160
  584. 13237  IF ERL=5300 THEN IF ERR=53 THEN RESUME 2210 ELSE RESUME 5310
  585. 13238  IF ERL=5323 THEN IF ERR=53 OR ERR=64 THEN MES$=MB$:GRN$="":RESUME 5310 ELSE RESUME 5325
  586. 13239  IF ERL=5327 THEN IF ERR=53 OR ERR=64 THEN UF$=UF1$:GOSUB 21990:GET 1,1:MID$(R$,57,5)=STR$(NUR):MID$(R$,62,5)=STR$(HUR):PUT 1,1:GOSUB 25000:TIX=MUIX:RESUME 5345 ELSE RESUME 5330
  587. 13240  IF ERL=5535 AND ERR=57 THEN R1=INP(LSR):RESUME 20015
  588. 13250  IF ERL=5535 THEN RESUME 5530
  589. 13255  IF ERL=7100 AND ERR=53 THEN Z$="Missing File "+F$:GOSUB 13670:RESUME 6080
  590. 13260  IF ERL=7110 THEN RESUME 6080
  591. 13270  IF ERL=7130 AND ERR=52 THEN RESUME 7260
  592. 13280  IF ERL=10600 AND ERR=63 THEN 10595
  593. 13310  IF ERL=10720 THEN IF ERR=53 OR ERR=64 THEN RESUME 1495
  594. 13312  IF ERL=10986 AND ERR=58 THEN RESUME 10987
  595. 13314  IF ERL=10986 THEN A$="Door "+Z$+" closed"+TT$:GOSUB 1405:RESUME 1200
  596. 13340  IF ERL=12570 AND ERR=53 THEN RESUME 710
  597. 13355  IF ERL=20165 AND ERR=58 THEN RESUME 20167
  598. 13357  IF ERL=20165 THEN RESUME 20170
  599. 13360  IF ERL=20220 AND ERR=53 THEN RESUME 20225
  600. 13370  IF ERL=20220 AND ERR=58 THEN OK=-1:RESUME 20225
  601. 13372  IF ERL=20220 AND ERR=64 THEN A$="Invalid file name":GOSUB 1405:RESUME 20200
  602. 13375  IF ERL=20240 AND ERR=53 THEN Z$="No File "+FB$:GOSUB 13670:RESUME 20247
  603. 13380  IF ERL=20440 AND ERR=58 THEN OK=0:RESUME 20450
  604. 13385  IF ERL=20440 AND ERR=53 THEN RESUME 20450
  605. 13390  IF ERL=20450 THEN OK=0:RESUME 20455
  606. 13400  IF ERL=20620 THEN OK=0:RESUME 20621
  607. 13402  IF ERL=20660 AND ERR=55 THEN X#=(CDBL(LOC(2))*128)+128:RESUME 20700
  608. 13405  IF ERL=20735 AND ERR=53 THEN RESUME 1495
  609. 13410  IF ERL=20840 THEN RESUME 20840
  610. 13420  IF ERL=21130 THEN OK=0:RESUME 21131
  611. 13430  IF ERL=21280 THEN RESUME 21280
  612. 13440  IF ERL=21360 THEN RESUME 21360
  613. 13442  IF ERL=21420 THEN RESUME 21420
  614. 13443  IF ERL=43030 AND ERR=58 THEN OK=-1:RESUME 43031
  615. 13445  IF ERL=43030 AND ERR=53 THEN RESUME 43031
  616. 13446  IF ERL=52000 AND ERR=53 THEN IF Z$=CG$ THEN CLOSE 2:OPEN "O",2,CG$:CLOSE 2:RESUME 52000
  617. 13447  IF ERL=52000 AND ERR=53 THEN A$="Upload directory file missing"+TT$:GOSUB 1405:RESUME 1200
  618. 13450  IF 65535=ERL THEN 50000
  619. 13460  IF ERR=5 THEN 10595
  620. 13470  IF ERR=57 OR ERR=24 OR ERR=25 THEN GOSUB 50500:R1=INP(MSR):IF R1<128 THEN RESUME 10595
  621. 13480  IF ERR=61 THEN A$="* Disk full - terminating *":GOSUB 1399:GOSUB 33090:GOSUB 13660:RESUME 13540
  622. 13490  IF ERR=71 THEN GOSUB 13630:RESUME 20015
  623. 13500  GOSUB 13660:A$=A$+TT$:GOSUB 1405:RESUME 1200
  624. 13540  IF LJ THEN 13549
  625. 13543  IF NOT SH THEN IF UIX=0 OR NF=-1 THEN 13549
  626. 13545  GOSUB 56000:GOSUB 43050
  627. 13549  GOSUB 13700:GOSUB 13550:GOSUB 21990:GET 1,NC:WI=0:MID$(R$,57,1)="I":MID$(R$,40,2)=STR$(WI):PUT 1,NC:GOSUB 25000:CLOSE:IF CYC THEN 31000 ELSE RUN
  628. 13550  IF LJ THEN RETURN
  629. 13560  GOSUB 50510:OUT MCR,INP(MCR) AND 254:GOSUB 50500:OUT MCR,INP(MCR) OR 1:RETURN
  630. 13600  CLS:LOCATE,,0:PRINT DF$;" file not found/invalid.  Run CONFIG.":GOSUB 50510:GOTO 31000
  631. 13630  A$="File Menu not available.":GOTO 1405
  632. 13650  CLS:LOCATE,,0:PRINT"Not enough memory for RBBS":GOSUB 50510:GOTO 31000
  633. 13660  A$="+++ Error "+STR$(ERR)+" line "+STR$(ERL)+" at "+TIME$+" on "+DATE$:Z$=A$
  634. 13670  Z$=SPACE$(5)+Z$:GOSUB 56000:LSET CL$=Z$:CDX=CDX+1:PUT 2,CDX
  635. 13674  IF LH THEN LPRINT Z$:RETURN ELSE RETURN
  636. 13700  IF NQ THEN GOSUB 25000
  637. 13710  IF UQ THEN GOSUB 27000
  638. 13720  IF UQB THEN GOSUB 27500:RETURN ELSE RETURN
  639. 14500  A$="ATQ1E1H1M0":GOSUB 52070:CLOSE 3:RETURN
  640. 20015  GOSUB 49000:AM$="F":GOSUB 41050:NH=0:IF NOT XPR THEN F$=ME$(3):GOSUB 43025
  641. 20030  A$=GRN$+"File Func <D,G,H,L,N,Q,S,U,X,?>":GOSUB 1499:IF Q=0 THEN 20015
  642. 20050  LN=0:Z$=B$(1):GOSUB 5000:FF=INSTR("DGHLNQSUX?",Z$):IF FF=0 THEN J=1:GOSUB 1360:GOTO 20015 ELSE IF UG<FS(FF) THEN RS$="File "+Z$:GOSUB 1380:GOTO 20015
  643. 20070  ON FF GOSUB 20180,20100,20110,20150,53000,20090,52900,20400,4240,20130:GOTO 20015
  644. 20090  RETURN 20095
  645. 20093  IF UIX>0 THEN GOSUB 9400:GET 2,UIX:GOSUB 9500
  646. 20095  RETURN 1200
  647. 20100  RETURN 10560
  648. 20110  F$=HE$(5):GOTO 1790
  649. 20130  F$=HE$(6):GOTO 1790
  650. 20150  ED=LEN(FA$)+(NOT SH):LD=-1:IF Q<2 THEN Q=2:B$(Q)=DIR$
  651. 20160  X=2:QX=Q
  652. 20161  IF X>QX THEN RETURN ELSE IF INSTR(B$(X),".") THEN 20172
  653. 20162  FOR JJ=1 TO ED:F$=MID$(FA$,JJ,1)+":"+B$(X)+"."+DIR$
  654. 20165  GOSUB 43030:NAME F$ AS F$
  655. 20167  IF LN THEN GOSUB 7000:GOTO 20175 ELSE GOSUB 6000:GOTO 20175
  656. 20170  NEXT
  657. 20172  A$="No directory "+B$(X):GOSUB 1400
  658. 20175  X=X+1:GOTO 20161
  659. 20180  IF Q>1 THEN B=2:GOTO 20202
  660. 20200  A$=F8$+"download":GOSUB 1500:B=1:IF Q=0 THEN RETURN
  661. 20202  A=1:IF Q>B THEN A=VAL(B$(B+1)):IF A<1 THEN A=1
  662. 20205  Z$=B$(B):RS$="Download ":FOR X=A TO LEN(FA$)-1:GOSUB 20741:ON A GOTO 20220,20231
  663. 20220  OK=0:NAME F$ AS F$
  664. 20225  IF OK THEN 20235
  665. 20230  NEXT
  666. 20231  Z$=B$(B)+" not found!":GOSUB 13670:A$=Z$+" Type L for directory":GOSUB 1400:RETURN 20015
  667. 20235  Z$=F$:A$=MES$:GOSUB 43040:A$=LG$(11):GOSUB 43040:A$=CG$:GOSUB 43040:A$=UF$:GOSUB 43040:A$=UF$+".BAK":GOSUB 43040:A$=CF$:GOSUB 43040:A$=RC$:GOSUB 43040:A$=CH$:GOSUB 43040:A$=PD$:GOSUB 43040:A$=FB$:GOSUB 43040:FH$="(D) "+Z$
  668. 20240  CLOSE 2:OPEN FB$ FOR INPUT AS 2:N$=Z$:GOSUB 20282:LG$(9)=DR$:LG$(21)=X$:LG$(10)=EXT$
  669. 20242  IF EOF(2) THEN 20247 ELSE INPUT #2,N$,DF,DF$:GOSUB 20282
  670. 20243  IF DR$<>"" AND DR$<>LG$(9) THEN 20242 ELSE A$=LG$(21):Z$=X$:GOSUB 20285:IF OK THEN 20242 ELSE A$=LG$(10):Z$=EXT$:GOSUB 20285:IF OK THEN 20242
  671. 20244  IF UG<DF THEN 20245 ELSE IF DF$="" THEN 20247 ELSE Z$=DF$:GOSUB 5000:DF$=Z$:IF DF$=PW$ THEN 20247 ELSE A$="Enter PASSWORD for downloading "+F$:GOSUB 1500:Z$=B$(1):GOSUB 5000:IF Z$=DF$ THEN 20247
  672. 20245  RS$="DownLoad "+F$:GOSUB 1380:RETURN 20015
  673. 20247  DF=0:EXT$=RIGHT$(F$,4):IF INSTR(".WRK.FW .ARC.EXE.COM.OBJ.WKS.LBR",EXT$) OR MID$(EXT$,3,1)="Q" OR (BD AND EXT$=".BAS") THEN A$="Non-ASCII transfer required":GOSUB 1405:DF=-1
  674. 20248  T$="Download"+FU$:GOSUB 21620:IF FF THEN 20260 ELSE GOSUB 21600
  675. 20260  HH=1:ON FF GOTO 20340,20262,20290,1495
  676. 20262  IF NOT -(CE*MN) THEN A$="MNP unavailable":GOSUB 1405:ON HH GOTO 1495,1495 ELSE LL=HH*HH:LL=LL-HH:GOSUB 20264:ON LL+HH GOTO 20385,20266,20660,20730:STOP
  677. 20264  CLOSE 3:OUT MCR,INP(MCR) OR 1:CALL MNP(HH,F$,CP$,BPS):OPEN CP$+":"+MID$("    300 45012002400",(-4*BPS),4)+","+MID$("N,8,1E,7,",6+5*BE,4)+"1,RS,CD,DS" AS 3:RETURN
  678. 20266  A$="<Download aborted>":SN=0:GOTO 20390
  679. 20282  Z$=N$:GOSUB 5000:IF MID$(Z$,2,1)=":" THEN DR$=LEFT$(Z$,1):S=3 ELSE DR$="":S=1
  680. 20283  XXX=INSTR(Z$+".","."):X$=MID$(Z$,S,XXX-S):EXT$=MID$(Z$,XXX+1,3):RETURN
  681. 20285  OK=0:K=0:L=LEN(A$)
  682. 20286  K=K+1:IF K>L THEN 20288 ELSE B$=MID$(Z$,K,1):IF B$="*" THEN RETURN
  683. 20287  IF B$<>"?" AND MID$(A$,K,1)<>B$ THEN OK=-1:RETURN ELSE 20286
  684. 20288  IF L<LEN(Z$) AND MID$(Z$,L+1,1)<>"*" THEN OK=-1:RETURN ELSE RETURN
  685. 20290  CLOSE 2:OPEN "R",2,F$,128:TLA=165:GOSUB 20750:A1$="SEND":GOSUB 20320:GOSUB 21300:A$="":GOTO 20390
  686. 20320  IF NOT BE THEN A$="Please SWITCH to N,8,1 for binary transfer":GOSUB 1398:GOSUB 50510
  687. 20325  A$="XMODEM "+A1$+" ready.  <Ctrl X> aborts":GOSUB 1405:GOTO 50500
  688. 20340  IF DF THEN A$="Switch to XMODEM or MNP":GOSUB 1405:GOTO 20015 ELSE CLOSE 2:OPEN "I",2,F$:TLA=139:GOSUB 20750:A$="* <Ctrl X> aborts <Ctrl S> suspends *":GOSUB 1400:A$="ASCII SEND ready. Press <C/R> to start":GOSUB 1500
  689. 20380  STI=-1:GOSUB 6030:IF RET THEN A$="<*>Download aborted<*>":SN=0:GOTO 20390
  690. 20381  A$=CHR$(26):GOSUB 1400:IF NOT LJ THEN FOR X=1 TO 5:PRINT#3,CHR$(7):GOSUB 50510:NEXT
  691. 20385  A$="<End of file>":SN=-1
  692. 20390  GOSUB 1400:GOTO 50600
  693. 20400  GOSUB 41010:Q!=TCA!:IF Q>1 THEN B$(1)=B$(2):GOTO 20430
  694. 20420  A$=F8$+"upload":GOSUB 1500:IF Q=0 THEN RETURN
  695. 20430  Z$=B$(1):RS$="Upload ":FOR X=1 TO LEN(FA$):GOSUB 20741:ON A GOTO 20440,20420
  696. 20440  OK=-1:NAME F$ AS F$
  697. 20450  IF OK THEN 20455
  698. 20451  IF UG>=UPS THEN A$="Overwrite file":GOSUB 1500:IF YES THEN 20475
  699. 20453  CLOSE 2:A$=Z$+" exists! Use a new file name":GOSUB 1400:GOTO 20420
  700. 20455  NEXT:F$=RIGHT$(FA$,1)+":"+Z$:Z$=UB$
  701. 20475  Z$=LEFT$(F$,2)+Z$:GOSUB 1400:GOSUB 52000:A$="Upload disk has"+AD$:GOSUB 1400:FH$="(U) "+F$:GOSUB 950:T$="Upload"+FU$:IF NOT OK THEN KILL F$:OK=-1
  702. 20477  GOSUB 21620:IF FF THEN 20500 ELSE GOSUB 21600
  703. 20500  HH=2:ON FF GOTO 20560,20262,20540,20735
  704. 20510  IF PRT THEN PRINT "<Esc> by SYSOP aborts transfer":RETURN ELSE RETURN
  705. 20540  A1$="RECEIVE":GOSUB 20320:OK=-1:GOSUB 20860:X#=0:IF OK THEN X#=(CDBL(LOC(2))*128)+X#:GOTO 20700 ELSE 20730
  706. 20560  A$="Transfer MUST end with a <Ctrl-K>":GOSUB 1400:A$="ASCII RECEIVE ready":GOSUB 1405:OK=0:X=0:CLOSE 2:OPEN "O",2,F$:GOSUB 20510
  707. 20600  WHILE NOT EOF(3):GOSUB 42000:IF LOF(3)<512 THEN PRINT#3,XA$;:X=-1
  708. 20610  X$=INPUT$(LOC(3),3):IF INSTR(X$,CHR$(11))THEN 20650
  709. 20620  OK=-1:PRINT#2,X$;:IF PRT THEN PRINT X$;
  710. 20621  X$=INKEY$:FK$=X$:GOSUB 60000:IF NOT OK THEN 20670
  711. 20630  WEND:GOSUB 42000:IF X THEN X=0:PRINT#3,XON$;
  712. 20640  IF INKEY$=ESC$THEN 20745 ELSE 20600
  713. 20650  X=INSTR(X$,CHR$(11)):IF X<>1 THEN PRINT#2,LEFT$(X$,X-1) ELSE IF NOT OK THEN 20730
  714. 20660  A$="Upload complete":GOSUB 1405:OPEN "A",2,F$:X#=(CDBL(LOC(2))*128)+128:GOTO 20700
  715. 20670  A$=XA$+"System error! Upload aborted <Ctrl-K> continues
  716. 20675  GOSUB 1405:GOSUB 50510:PRINT#3,XON$;
  717. 20680  WHILE NOT EOF(3):X$=INPUT$(LOC(3),3):IF INSTR(X$,CHR$(11))THEN 20730
  718. 20685  GOSUB 42000:WEND:GOTO 20680
  719. 20700  BX=&H4:EN$=RIGHT$(FA$,1)+UB$:GOSUB 29000:CLOSE 2:OPEN "A",2,RIGHT$(FA$,1)+":"+UB$:A1$=MID$(F$,3):BX=&H4:EN$=RIGHT$(FA$,1)+UB$:GOSUB 29500
  720. 20710  A$="Describe "+A1$+" (/ if for SYSOP only)"+RTN$+" |----+---1+0---+---2+0---+---3+0---+---4+0":GOSUB 1398:GOSUB 1500:IF LEN(B$(1))>40 THEN 20710
  721. 20720  IF LEFT$(B$(1),1)="/"THEN 20725 ELSE PRINT#2,USING"\           \########  &  &";A1$;X#;LEFT$(DATE$,6)+RIGHT$(DATE$,2);B$(1)
  722. 20725  CLOSE 2:Y$=" >> uploaded << ":ULD=ULD+1:GOSUB 41010:TV!=TV!+UPX!*(TCA!-Q!):GOTO 50610
  723. 20730  A$="Upload aborted":GOSUB 1405
  724. 20735  CLOSE 2:KILL F$:RETURN
  725. 20741  A=1:GOSUB 5000:F$=MID$(FA$,X,1)+":"+Z$:IF INSTR(F$,"?") OR INSTR(F$,"*") OR INSTR(F$," ") OR INSTR(F$,".DEF") OR INSTR(F$,".OLD") OR INSTR(3,F$,":") OR MID$(F$,LEN(F$),1)="." THEN A=2:RETURN
  726. 20742  IF LEN(Z$)=>3 THEN IF INSTR("COM1:COM2:LPT1:LPT2:LPT3:PRN:CON:AUX",Z$) THEN NI=VB:RS$=RS$+Z$:GOSUB 1380
  727. 20743  RETURN
  728. 20745  A$=XA$+"SYSOP aborted upload. Stop tranfer. <Ctrl-K> continues":GOTO 20675
  729. 20750  IX#=FIX(LOF(2)/128):X#=LOF(2)/128:IF IX#<>X#THEN X#=X#+1
  730. 20780  A$=STR$(INT(X#))+" blocks in file":GOSUB 1405:X#=X#*TLA/VAL(MID$("00030045120240",-3*BPS,3)):IF LOF(2)<1 THEN 20015
  731. 20790  GOSUB 950:A$="Transfer time:"+STR$(INT(X#/60))+" min,"+STR$(X#MOD 60)+" sec":GOSUB 1405:GOSUB 41000:IF(INT(X#/60)+1)>INT(TR!)THEN A$="Not enough time left!":Z$=F$+" "+A$:GOSUB 1405:GOSUB 13670:GOSUB 20015 ELSE RETURN
  732. 20810  GOSUB 42000:Y$="":DE!=FNTI!+2
  733. 20840  IF NOT EOF(3)THEN Y$=INPUT$(LOC(3),3):RETURN
  734. 20850  IF FNTI!<DE! THEN 20840 ELSE Y$="":RETURN
  735. 20860  GOSUB 20992:IF NOT BE THEN GOSUB 21280
  736. 20900  X$="":SEC=1:CLOSE 2:OPEN "R",2,F$,128:FIELD 2,128 AS Z$:PRINT #3,NAK$;:CTI!=FNTI!+TY
  737. 20920  FOR X=1 TO 10:Y$=INKEY$:IF Y$=ESC$THEN 21270 ELSE GOSUB 20810
  738. 20930  IF LEFT$(Y$,1)=SOH$THEN 21020
  739. 20940  IF LEFT$(Y$,1)=EOT$THEN 21220
  740. 20950  IF LEFT$(Y$,1)=CAN$THEN 21230
  741. 20960  IF Y$<>"" THEN GOSUB 21280:IF FNTI!<CTI! THEN 20920 ELSE GOTO 21230
  742. 20970  NEXT:PRINT#3,NAK$;:IF PRT THEN PRINT"Timeout":CTI!=FNTI!+TY
  743. 20990  GOTO 20920
  744. 20992  GOSUB 20510:IF NOT BE THEN GOSUB 50510:OUT LCR,3
  745. 20996  SO=0:RETURN
  746. 21000  GOSUB 20810:IF Y$="" THEN PRINT"Timeout":GOTO 21040
  747. 21020  X$=X$+Y$:IF LEN(X$)<132 THEN 21000
  748. 21040  IF LEN(X$)=132 THEN 21090
  749. 21050  IF LEN(X$)>132 THEN 21180
  750. 21060  IF X$=EOT$THEN 21220
  751. 21070  IF X$=CAN$THEN 21230
  752. 21080  GOTO 21170
  753. 21090  IF SEC<>ASC(MID$(X$,2,1))THEN 21200
  754. 21100  IF(SEC XOR 255)<>ASC(MID$(X$,3,1))THEN 21210
  755. 21110  CK=0:FOR I=1 TO 128:CK=CK+ASC(MID$(X$,I+3,1)):NEXT:CK=(CK AND 255):IF CK<>ASC(MID$(X$,132,1))THEN 21190
  756. 21120  SO=SO+1
  757. 21130  PRINT#3,ACK$;
  758. 21131  LSET Z$=MID$(X$,4):PUT 2:IF NOT OK THEN 21230
  759. 21145  SEC=255 AND(SEC+1):IF PRT THEN LOCATE ,1:PRINT "Verified Rec Blk #";SO;
  760. 21150  X$=INKEY$:FK$=X$:GOSUB 60000:CK=0:CTI!=FNTI!+TY:GOTO 20920
  761. 21170  A$="Short Blk in #":GOTO 21212
  762. 21180  A$="Long Blk in #":GOTO 21212
  763. 21190  A$="Checksum"+E1$:GOTO 21212
  764. 21200  A$="Blk #"+E1$:IF SEC-1<>ASC(MID$(X$,2,1)) THEN 21212 ELSE PRINT #3,ACK$;:GOTO 21150
  765. 21210  A$="Complement"+E1$
  766. 21212  PRINT#3,NAK$;:IF PRT THEN PRINT LF$;A$;SO+1:GOTO 21150 ELSE GOTO 21150
  767. 21220  IF PRT THEN PRINT LF$;"File Closed
  768. 21225  PRINT#3,ACK$;:GOTO 21250
  769. 21230  IF PRT THEN PRINT LF$;"Transfer Aborted
  770. 21240  OK=0:PRINT#3,CAN$;CAN$;
  771. 21250  IF NOT BE THEN BE=-1:RETURN ELSE RETURN
  772. 21270  GOSUB 20510:GOSUB 21280:GOTO 21240
  773. 21280  WHILE NOT EOF(3):GOSUB 42010:DF$=INPUT$(LOC(3),3):WEND:RETURN
  774. 21300  GOSUB 20992:SEC=0:GOSUB 21280:FIELD 2,128 AS X$
  775. 21350  WHILE NOT EOF(3)
  776. 21360  Y$=INPUT$(1,3):IF Y$=CAN$THEN 21560
  777. 21380  IF Y$=NAK$THEN 21480
  778. 21390  WEND:GOSUB 21460:GOTO 21350
  779. 21410  CTI!=FNTI!+TY:WHILE NOT EOF(3)
  780. 21420  Y$=INPUT$(1,3):IF Y$=ACK$THEN 21470
  781. 21440  IF Y$<>NAK$ THEN 21450
  782. 21443  IF PRT THEN PRINT LF$;"Error -> retrans #";SO
  783. 21445  SO=SO-1:GOTO 21490
  784. 21450  IF Y$=CAN$ THEN 21560 ELSE WEND:GOSUB 21460:IF FNTI!<CTI! THEN GOTO 21410 ELSE PRINT "Download timeout":GOTO 21560
  785. 21460  GOSUB 42000:Y$=INKEY$:FK$=Y$:GOSUB 60000:IF Y$=ESC$ THEN RETURN 21540 ELSE RETURN
  786. 21470  IF PRT THEN LOCATE ,1:PRINT "Verified Sent Block #";SO;
  787. 21480  IF LOC(2)<LOF(2)/128 THEN GET 2:SEC=255 AND(SEC+1):GOTO 21490
  788. 21482  IF PRT THEN PRINT LF$;"End of file
  789. 21485  GOTO 21530
  790. 21490  SO=SO+1:PRINT#3,SOH$;CHR$(SEC);CHR$(SEC XOR 255);X$;
  791. 21503  CK=0:FOR I=1 TO 128:CK=CK+ASC(MID$(X$,I,1)):NEXT:CK=(CK AND 255)
  792. 21504  IF CK>256 THEN CK=CK-256:GOTO 21504
  793. 21510  PRINT#3,CHR$(CK);:GOSUB 21280:GOTO 21410
  794. 21530  PRINT#3,EOT$;:FOR X=1 TO 100:GOSUB 20810:IF Y$=ACK$THEN 21550 ELSE Y$=INKEY$:IF Y$=ESC$ THEN 21540
  795. 21535  NEXT:GOTO 21230
  796. 21540  GOSUB 20510:Y$=CAN$:PRINT#3,CAN$;CAN$;:GOTO 21250
  797. 21550  SN=-1:GOTO 21250
  798. 21560  SN=0:IF PRT THEN PRINT LF$;"Receiver aborted transfer":GOTO 21250 ELSE RETURN
  799. 21600  CR=0:A$=T$:GOSUB 1500:IF Q=0 THEN 21600 ELSE Z$=B$(1)
  800. 21610  GOSUB 5000:FF=INSTR("AMXQ",Z$):IF FF<1 OR (FF=2 AND NOT MN) THEN 21600 ELSE FT$=MID$("AMX ",FF,1):RETURN
  801. 21620  FF=-1:IF Q>2 THEN Z$=B$(3):GOTO 21610 ELSE IF LG$(20)>" " THEN Z$=LG$(20):GOTO 21610 ELSE FF=0:RETURN
  802. 21990  GOSUB 22000:GOTO 30500
  803. 21995  GOSUB 27000:GOTO 25000
  804. 21996  GOSUB 30000:GOTO 25000
  805. 21997  GOSUB 26500:GOTO 9400
  806. 22000  NQ=-1:MID$(LS$,1,2)="LM":GOSUB 950:DF$=MES$:ON SB GOTO 22100,22200,22300:RETURN
  807. 22100  AX=&H0:BX=&H1:GOTO 60510
  808. 22200  CC$=CHR$(1)+MID$(MES$+SPACE$(8),3,8):GOSUB 28000:IF CT=0 THEN RETURN ELSE GOSUB 50500:GOTO 22200
  809. 22300  GOSUB 28100:CALL LPLKIT(DF,DF$,A):RETURN
  810. 23000  GET 1,1:LE=VAL(LEFT$(R$,8)):CJ#=VAL(MID$(R$,11,10)):NUR=VAL(MID$(R$,57,5)):HUR=VAL(MID$(R$,62,5)):FMR=VAL(MID$(R$,68,7)):NMR=VAL(MID$(R$,75,7)):HMR=VAL(MID$(R$,82,7)):MG=VAL(MID$(R$,127)):RETURN
  811. 24000  MID$(R$,1,8)=STR$(LE):MID$(R$,11,10)=STR$(CJ#):MID$(R$,57,5)=STR$(NUR):MID$(R$,62,5)=STR$(HUR):MID$(R$,68,7)=STR$(FMR):MID$(R$,75,7)=STR$(NMR):MID$(R$,82,7)=STR$(HMR):MID$(R$,127,2)=STR$(MG):PUT 1,1:RETURN
  812. 25000  NQ=0:MID$(LS$,1,2)="UM":GOSUB 950:DF$=MES$:ON SB GOTO 25100,25200,25300:RETURN
  813. 25100  AX=&H100:BX=&H1:GOTO 60510
  814. 25200  CC$=CHR$(17)+MID$(MES$+SPACE$(8),3,8):GOSUB 28000:IF CT=128 THEN RETURN ELSE GOSUB 50500:GOTO 25200
  815. 25300  GOSUB 28100:CALL UNLOKIT(DF,DF$,A):RETURN
  816. 26000  UQ=-1:MID$(LS$,4,2)="LU":GOSUB 950:DF$=UF$:ON SB GOTO 26100,26200,22300:RETURN
  817. 26100  AX=&H0:BX=&H2:GOTO 60510
  818. 26200  CC$=CHR$(1)+MID$(UF$+SPACE$(8),3,8):GOSUB 28000:IF CT=0 THEN RETURN ELSE GOSUB 50500:GOTO 26200
  819. 26500  UQB=-1:BLK=(UIX/4)+0.26:MID$(LS$,7,2)="LB":GOSUB 950:ON SB GOTO 26600,26700,26800:RETURN
  820. 26600  AX=&H0:BX=BLK+10:GOTO 60510
  821. 26700  CC$=CHR$(1)+FNBL$:GOSUB 28000:IF CT=0 THEN RETURN ELSE GOSUB 50500:GOTO 26700
  822. 26800  DF$=LEFT$(UF$,2)+FNBL$:GOTO 22300
  823. 27000  UQ=0:MID$(LS$,4,2)="UU":GOSUB 950:DF$=UF$:ON SB GOTO 27100,27200,25300:RETURN
  824. 27100  AX=&H100:BX=&H2:GOTO 60510
  825. 27200  CC$=CHR$(17)+MID$(UF$+SPACE$(8),3,8):GOSUB 28000:IF CT=128 THEN RETURN ELSE GOSUB 50500:GOTO 27200
  826. 27500  UQB=0:BLK=(UIX/4)+0.26:MID$(LS$,7,2)="UB":GOSUB 950:ON SB GOTO 27600,27700,27800:RETURN
  827. 27600  AX=&H100:BX=BLK+10:GOTO 60510
  828. 27700  CC$=CHR$(17)+FNBL$:GOSUB 28000:IF CT=128 THEN RETURN ELSE GOSUB 50500:GOTO 27700
  829. 27800  DF$=LEFT$(UF$,2)+FNBL$:GOTO 25300
  830. 28000  CC$=LF$+CHR$(0)+CHR$(11)+CC$:CALL CDSEND(CC$):CALL CDRECV(CN$):CT=ASC(MID$(CN$,3,1)):IF CT=>128 THEN PRINT "CORVUS LOCK FAIL":GOTO 31000
  831. 28010  CT=ASC(MID$(CN$,4,1)):IF CT=>129 THEN PRINT "CORVUS FULL":GOTO 31000 ELSE RETURN
  832. 28100  DF=ASC(LEFT$(UF$,1))-ASC("A"):DF$=DF$+STRING$(32-LEN(DF$),0):A=0:RETURN
  833. 29000  MID$(LS$,10,2)="LD":GOSUB 950:DF$=EN$:ON SB GOTO 29100,1495,22300:RETURN
  834. 29100  AX=&H0:BX=&H3:GOTO 60510
  835. 29500  MID$(LS$,10,2)="UD":GOSUB 950:DF$=EN$:ON SB GOTO 29600,1495,25300:RETURN
  836. 29600  AX=&H100:BX=&H3:GOTO 60510
  837. 30000  CLOSE 1:OPEN "I",1,CA$:CLOSE 1:RETURN
  838. 30500  CLOSE 1:OPEN "R",1,MES$:FIELD 1,128 AS R$:RETURN
  839. 31000  IF MC THEN GOSUB 60500:SYSTEM ELSE SYSTEM
  840. 32000  CLS:IF MC THEN GOSUB 60500:END ELSE END
  841. 33000  LH=NOT LH:QQ=LH:JJ=38:GOTO 33950
  842. 33040  AC=NOT AC:QQ=AC:JJ=34:GOTO 33950
  843. 33060  RETURN 320
  844. 33070  AVA=NOT AVA:QQ=AVA:JJ=32:GOTO 33950
  845. 33090  SG=NOT SG:QQ=SG:JJ=36:GOTO 33950
  846. 33110  SH=NOT SH:C.C=CSRLIN:C.L=POS(0):LOCATE 25,1:PRINT SPACE$(79);:LOCATE 25,1:UG=(1+SH)*HUG-SH*SE:PRINT "Temp SYSOP Privileges ";MID$("OFFON",1-3*SH,3);:GOSUB 50510:LOCATE C.C,C.L:GOTO 49000
  847. 33130  PRT=NOT PRT:IF PRT THEN LOCATE 23,1,0:PRINT"SNOOP ON":GOSUB 953 ELSE LOCATE,,0:CLS
  848. 33140  QQ=PRT:JJ=58:GOTO 33950
  849. 33150  A$="Hi, this is "+NA$+" "+NB$+" in CHAT mode. Sorry to break in but..":GOSUB 1400:GOTO 4770
  850. 33950  IF PRT THEN GOSUB 49000
  851. 33960  IF GRF=0 THEN GOSUB 21990:GET 1,NC:MID$(R$,JJ,2)=STR$(QQ):GOTO 43080
  852. 40000  A$="Cannot change status during Conference!":GOTO 1400
  853. 41000  GOSUB 41010:IF TN THEN RETURN ELSE IF TR!<0 THEN TR!=0:RETURN 10553 ELSE RETURN
  854. 41010  TOA!=FRE("A"):IF FNTI!>TI!THEN TCA!=FNTI!-TI! ELSE TCA!=FNTI!+86400-TI!
  855. 41020  TR!=(TV!-TCA!+CH!)/60:TR$=STR$(INT(TR!)):RETURN
  856. 41050  GOSUB 41000:A$=TR$+" min left":GOTO 1398
  857. 41070  A$="Granted access level"+STR$(UG)+MID$(" (SYSOP)",1,-8*(UG>=SE)):GOTO 1398
  858. 41500  TI$=TIME$:D$=LEFT$(DATE$,6)+RIGHT$(DATE$,2)
  859. 41510  TIM$=TIME$:IF FNV(TIM$,1)=12 THEN MID$(TIM$,1,2)=RIGHT$(STR$(FNV(TIM$,1)),2):TIM$=LEFT$(TIM$,5)+" PM":RETURN
  860. 41520  IF FNV(TIM$,1)>11 THEN MID$(TIM$,1,2)=RIGHT$(STR$(FNV(TIM$,1)-12),2):TIM$=LEFT$(TIM$,5)+" PM":RETURN ELSE TIM$=LEFT$(TIM$,5)+" AM":RETURN
  861. 42000  IF LJ THEN RETURN:IF CTI!>TI!THEN CTI!=TI!+(10*60)
  862. 42010  IF INP(MSR)<128 AND NOT LJ THEN GOSUB 9140:GOTO 10595:RETURN ELSE RETURN
  863. 42700  A$="Want nulls":GOSUB 1500:IF NO OR YES THEN NK=NO ELSE 42700
  864. 42710  NK=NOT NK:GOSUB 9520
  865. 42720  A$="Nulls "+MID$("OffOn",1-3*NK,3):GOTO 2210
  866. 42800  T$="FILE transfer default"+FU$:GOSUB 21600:LG$(20)=FT$
  867. 42810  A$="PROTOCOL: "+MID$("Ascii MNP   XmodemNone",6*FF-5,6):GOTO 2210
  868. 42950  A$="CAN YOUR TERMINAL DISPLAY LOWER CASE":GOSUB 1500:Z$=B$(1):GOSUB 5000:IF NO OR YES THEN UC=YES ELSE 42950
  869. 42960  UC=NOT UC:A$="UPPER CASE "+MID$("and lowerONLY",1-9*UC,9):GOTO 2210
  870. 43000  IF NOT BE THEN A$="Graphics unavailable":GOTO 2210
  871. 43005  A$="GRAPHICS wanted: <N>one,<A>scii,<C>olor,<H>elp":GOSUB 1500:Z$=B$(1):GOSUB 5000:GR=INSTR("NAC",Z$):IF GR<1 THEN DF$=HU$:F$=HE$(9):GOSUB 1790:GOSUB 9400:LSET HU$=DF$:GOTO 43005 ELSE LG$(19)=MID$(" GC",GR,-(GR>1)):GR=GR-1
  872. 43020  A$="GRAPHICS: "+MID$("None AsciiColor",GR*5+1,5):GOTO 2210
  873. 43025  GOSUB 43030:GOTO 45000
  874. 43030  OK=0:IF GR THEN N$=F$:GOSUB 20282:IF LEN(X$)<8 THEN DF$=DR$+":"+X$+LG$(19)+"."+EXT$:NAME DF$ AS DF$
  875. 43031  IF OK THEN F$=DF$:RETURN ELSE RETURN
  876. 43040  IF INSTR(3,Z$,MID$(A$,3,(LEN(A$)-2))) THEN RETURN 20245 ELSE RETURN
  877. 43050  FIELD 2,55 AS CL$,3 AS HHH$,3 AS MMM$, 3 AS SSS$:LSET CL$=MID$(NG$,65,55):LSET HHH$=STR$(HHH):LSET MMM$=STR$(MMM):LSET SSS$=STR$(SSS):CDX=CDX+1:PUT 2,CDX:FIELD 2,64 AS CL$:LSET CL$=LEFT$(NG$,64):CDX=CDX+1:PUT 2,CDX
  878. 43060  LSET CL$=STRING$(64,CHR$(0)):PUT 2:PUT 2:IF FE$=NA$ AND LK$=NB$ THEN SH=-1 ELSE SH=0
  879. 43070  GOSUB 21990:GET 1,NC:MID$(R$,40,2)=STR$(WI):MID$(R$,42,2)=STR$(BE):MID$(R$,44,2)=STR$(BPS):MID$(R$,46,2)=STR$(UC):MID$(R$,48,5)=SPACE$(5):KG=-1:GOSUB 41010:MID$(R$,48,5)=STR$(TR!):MID$(R$,53,2)=STR$(GR):MID$(R$,55,2)=STR$(SH)
  880. 43080  PUT 1,NC:GOSUB 21996:GOTO 30500
  881. 44000  GOSUB 21990:GET 1,NC:BE=FNV(R$,42):BPS=FNV(R$,44):UC=FNV(R$,46):TV!=VAL(MID$(R$,48,5)):GR=FNV(R$,53):SH=FNV(R$,55):IF BPS=-1 THEN Q=&H180
  882. 44005  IF BPS=-3 THEN Q=&H60 ELSE IF BPS=-4 THEN Q=&H30
  883. 44010  GOSUB 1654:TI!=FNTI!:IF TV!<60 THEN TV!=120
  884. 44015  IF NOT BE THEN OUT LCR,&H1A
  885. 44020  GOSUB 25000:IF SH THEN FE$=PB$:LK$=PC$:RETURN
  886. 44030  HH=INSTR(R$," "):JJ=INSTR(HH+1,R$," "):FE$=LEFT$(R$,HH-1):LK$=MID$(R$,HH+1,JJ-(HH+1)):GOTO 12550
  887. 45000  STI=0:GOSUB 6000:STI=-1:RETURN
  888. 45010  SI=-1:GOSUB 1500:SI=0:GOTO 2210
  889. 49000  FH$=MID$("    AVL ",1-4*AVA,4)+MID$("    ANY ",1-4*AC,4)+MID$("    LPT ",1-4*LH,4)+MID$("SYS",1,-3*SG):GOTO 950
  890. 50000  A$="Fatal error!":GOSUB 1405:GOTO 10595
  891. 50400  A$="A)bort, C)ontinue, D)elete, E)dit, I)nsert, L)ist, M)argin, S)ave":GOTO 1398
  892. 50500  DE!=FNTI!+1:GOTO 50520
  893. 50510  DE!=FNTI!+3
  894. 50520  IF FNTI!<DE! AND DE!< 86400 THEN 50520 ELSE RETURN
  895. 50600  IF SN=-1 THEN DLD=DLD+1:Y$=" Downloaded " ELSE Y$=" Aborted "
  896. 50610  IF LJ THEN RETURN ELSE GOSUB 41510:Z$=F$+Y$+"at "+TIM$+" using "+FT$:GOSUB 13670:IF LEFT$(B$(1),1)="/" THEN Z$=+"  file desc: "+B$(1):GOSUB 13670:RETURN ELSE RETURN
  897. 52000  CLS:FILES Z$:AD$="":FOR X=1 TO 25:AD$=AD$+CHR$(SCREEN(3,X)):NEXT:GOSUB 49000:IF INSTR(AD$,"Bytes free")THEN RETURN
  898. 52030  AD$=" ???":IF CE AND DA>1 THEN 52040 ELSE RETURN
  899. 52040  FF=INSTR("ABCDEFGHIJKLM",LEFT$(Z$,1)):IF FF=0 THEN RETURN
  900. 52060  CALL UTSPACE(FF,JJ,DF,L,X):TOA#=JJ:TOA#=((TOA#*L)*X):AD$=STR$(TOA#)+" Bytes free":RETURN
  901. 52070  IF D THEN WHILE (INP(MSR)AND &H40):WEND
  902. 52075  GOSUB 50500:PRINT #3,A$:RETURN
  903. 52900  CK=2:IF Q>1 THEN 52920
  904. 52910  A$="Search for string (C/R quits)":GOSUB 1500:IF Q=0 THEN RETURN ELSE B$(2)=B$(1)
  905. 52920  Z$=B$(2):GOSUB 5000:RS$=Z$:A1$=B$(2):GOTO 53007
  906. 53000  CK=1:IF Q>1 THEN 53005
  907. 53002  A1$=RIGHT$(LM$,4)+LEFT$(LM$,2):A$="Include files on/after (MMDDYY, C/R = last date on "+A1$+")":GOSUB 1500:IF Q=0 THEN RS$=LM$:GOTO 53007 ELSE B$(2)=B$(1)
  908. 53005  IF LEN(B$(2))<>6 THEN 53002 ELSE A1$=B$(2):RS$=RIGHT$(A1$,2)+LEFT$(A1$,4)
  909. 53007  IF Q>2 THEN B$(2)=B$(3):GOTO 53030
  910. 53010  A$="Directory to scan or ALL":GOSUB 1500:IF Q=0 THEN RETURN ELSE B$(2)=B$(1)
  911. 53030  Q=2:ED=LEN(FA$)-1:LD=-1:LN=-1:Z$=B$(2):GOSUB 5000:IF Z$="ALL" THEN 53070
  912. 53060  GOSUB 20160:LN=0:RETURN
  913. 53070  G=2:J=2:FOR JJ=1 TO ED:B$(2)=MID$(FA$,JJ,1)+":"+"*."+DIR$:GOSUB 10720:CLS:NEXT:GOSUB 49000:QX=G:X=3:GOSUB 20161:LN=0:RETURN
  914. 56000  CLOSE 2:OPEN "R",2,CF$,64:FIELD 2,64 AS CL$:RETURN
  915. 57000  GOSUB 1485:GOSUB 56000:PG=CDX
  916. 57005  IF PG <1 OR RET THEN RETURN
  917. 57010  GET 2,PG:A$=CL$:IF LEFT$(A$,3)=SPACE$(3) OR INSTR(A$,"on at")=0 THEN 57030
  918. 57025  PG=PG-1:GET 2,PG:A1$=LEFT$(CL$,15):IF SH OR LEFT$(A1$,3)<>SPACE$(3) THEN A$=A$+A1$
  919. 57027  GOSUB 57100:GOTO 57045
  920. 57030  IF SH THEN GOSUB 57100
  921. 57045  PG=PG-1:GOTO 57005
  922. 57100  GOSUB 1405
  923. 57110  IF PL AND Q>=0 THEN Q=Q+1:IF Q>=PL THEN GOSUB 5600:IF NO THEN RETURN 57120 ELSE Q=0
  924. 57120  RETURN
  925. 59000  PM$=" -  ":CALL UTGETPRM(PM$):PM$=MID$(PM$,2,1):NC=INSTR("-1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ",PM$): IF NC<2 THEN NC=2:MID$(CA$,5,1)="-":ND$="1":RETURN ELSE ND$=STR$(NC-1):MID$(CA$,5,1)=PM$:RETURN
  926. 60000  IF LEN(FK$) <> 2 THEN RETURN
  927. 60010  JJ=ASC(RIGHT$(FK$,1)):IF JJ<59 OR JJ>68 THEN RETURN ELSE JJ=JJ-58:ON JJ GOSUB 31000,32000,33000,33040,33060,33070,33090,33110,33130,33150:RETURN
  928. 60500  AX=&H100:BX=-4:IF CP$="COM2" THEN BX=-3
  929. 60510  DEF SEG=MC:IF NOT CE THEN PRINT"Make line # 60540 CALL CO(AX,BX):RETURN":RETURN
  930. 60550  CALL ABSOLUTE(AX,BX,CO):RETURN
  931. 62520  SQ=Q:LG$(10)=B$:SLI=LI:SL=S:SNS=NH:SR=R:RETURN
  932. 62530  Q=SQ:B$=LG$(10):LI=SLI:S=SL:NH=SNS:R=SR:KB=0:RETURN
  933.